#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"
#  TkZip  Copyright  1996 by Robert Woodside.
#  A Tk/Tcl program for managing zipped & tarred archives
#  01/13/1996 - Time to rip this apart and restructure...

#-------------------------------------------------
#            Set a few globals
#-------------------------------------------------
set PgmName "TkZip"
set Copy "Copyright  1996, 1997 by Robert Woodside."
set TkzVer 0.8.3b
set TkzDate 06/04/1997
set TkzTime 01:43:24
set Debugon 0
#set AuthEmail "root@localhost"
set AuthEmail "proteus@pcnet.com"
set PgmNamelc "tkzip"
set Windows 0
set Crippled 0
if [info exists embed_args] {
  set Crippled 1
  set Plugin 1
  }  else  {
  set Plugin 0
  }
if [catch {set TclVer $tcl_version}]  {set TclVer 0.0}
if [catch {set TkVer $tk_version}]  {set TkVer 0.0}

if {! $Crippled}  {
  if [info exists env(HOME)] {
    set Home $env(HOME)
    }  else  {
    set Home [pwd]
    }
  }  else  {
  set Home [pwd]
  }
set MyPid [pid]

#  Doesn't work under 4.0, dammit!
if {$TkVer > 4.0} {
  set OsName $tcl_platform(os)
  set OsVer $tcl_platform(osVersion)
  }  else  {
  if [catch {set OsName [exec uname -s]}]  {set OsName "Unknown System"}
  if [catch {set OsVer [exec uname -r]}]  {set OsVer "Unknown Version"}
  }
if {[string first "Windows" $OsName] != -1}  {
  set Windows 1
  set Crippled 1
  }
if {! $Crippled}  {
  if [catch {set WhoIAm [exec id -un]}]  {set WhoIAm ""}
  if [catch {set WhereIAm [exec hostname -f]}] {set WhereIAm ""}
  set TempDir "$Home/.TkZip$MyPid"
  }  else  {
  set WhoIAm ""
  set WhereIAm ""
  set TempDir "/Temp"
  }
set CacheDir $Home





#-------------------------------------------------
#  Init  --  Initialization
#-------------------------------------------------
proc Init {} {
global argc argv
global TclVer TkVer Debug Debugi Debugl Home TempDir CacheDir InitFile
global MainBg MainButBg WhoBg TBg TButBg TFg
global CurDir ExtDir TgzLstFlags TgzExtFlags ArcOnly ArcTypes
global FTypes RTypes ATypes RawDev ArcWin DirWin ExtWin TmpNo
global ArcPgm UnarcPgm ArcFlags ListFlags ExtFlags VNames VBins VNum
global GotTar GotGtar GotGzip GotZip GotZcat GotCompress GotPgms NoGotPgms NeededPgms GotPgmFlags NeededPgmFlags
global GotAr GotArj GotRar GotShn GotBzip GotLha GotCpio GotRpm 
global GotPgms2 NoGotPgms2 NeededPgms2 GotPgmFlags2 NeededPgmFlags2
global OvWarn OvOpt ForceStat Desperation IgnITG NoProbe MenuHelp ShDesperation ShIgnITG ShNoProbe
global WhoIAm WhereIAm EmUser EmHost MyPid
global Windows Crippled Plugin InitFlag NewRaw MainSelected
global VDWarn ADWarn MDWarn WhitePixel TheVisual ColorBits
global WinList FLList CldFlag CleFlag DseFlag SavOpt StdNames GnuLin 
global ShnHeur ColorHack FastClean MultView Vpn CompOpt ExtDirs

#  RBW - 01/20/1996 - we have some more types to add while we're restructuring...
#    -  a   - test with ar -V, look for "ar" and "GNU"; list with ar -tv; extract with x
#    -  arj - test with unarj, look for "UNARJ"; list with unarj -l; extrace with e or x
#    -  rar - test with unrar, look for "UNRAR"; list with unrar -l; extract with e or x
#    -  shn - shorten files - test with shorten -h, look for "shorten"
#    -  bzip - test with bzip -h (deliberately bad flag), look for "BZIP" in pos 1
#       - will be handled just like old style compress, it's not very informative
#    For shorten files, compressing may be a pain - you really need to be able to set
#    a bunch of options to control the lossiness.

#  Recognized archive types and raw archive device types
#  (A lot of people like names like "mystuff_tar.gz" - let's humor 'em....)
set FTypes ".tgz tar.z tar.Z tar.gz .zip .z .Z .tar .gz .taz .exe .a .rar .arj .shn .bz .lzh"
set RTypes "fd ftape rft rmt st nft nrft nrmt nst"
set ATypes "1 3 5 2 4 6 0   8 9 10 11 12"

set RawDev 0
#set NewRaw 0

set MainBg     "LightBlue"
set MainButBg  "SteelBlue"
set DisButFg   "Powder Blue"
set WhoBg      "AntiqueWhite"
set ColorHack 1

#-----------------------------------
#  Colors for specific archive types...
#  One of these days we'll make this user-configurable
#-----------------------------------
set TBg        "LightGrey MediumSpringGreen DarkSeaGreen SteelBlue bisque DarkSlateGrey MistyRose4 red red   yellow RosyBrown CadetBlue sienna ForestGreen DarkSalmon IndianRed4 turquoise1"
set TButBg     "bisque bisque bisque bisque sienna bisque bisque bisque bisque   bisque bisque bisque bisque bisque bisque bisque bisque"
set TFg        "black black black black black LightYellow black black black    black black black black black bisque white black"
#-----------------------------------

#  In case rgb.txt is messed up, here are  some of the actual values....
#     Dec                  Std Name              Hex  
#    -----                ----------            ----- 
# 173 216 230		LightBlue              #add8e6
#  70 130 180		SteelBlue              #4682b4
# 250 235 215		AntiqueWhite           #faebd7
# 255 228 196		bisque                 #ffe4c4
# 211 211 211		LightGrey              #d3d3d3
#   0 250 154		MediumSpringGreen      #00fa9a
# 188 143 143		RosyBrown              #bc8f8f
#  47  79  79		DarkSlateGrey          #2f4f4f
# 139 125 123		MistyRose4             #8b7d7b
# e.g., 
# set MainBg     "#add8e6"
# set MainButBg  "#4682b4"
# etc....
#  If this is an 8-bit display, some of the default colors will look pretty awful.
#  These are crappy, too, but should be legible. We'll add a color selection dialogue later.
#  --  This doesn't always work correctly. Sometimes WhitePixel has a value of 1 and it doesn't
#  mean monochrome, so...
#  We need to replace this with Tk commands to query the server's visual instead. I think winfo 
#  against the root window will get it.
set tmp ""
catch {set tmp [exec xset q]}
set tmpp [string first "WhitePixel:" $tmp]
if {$tmpp > 0}  {
  incr tmpp 12
  set WhitePixel [lindex [string range $tmp $tmpp end] 0]
  }
#  Not sure how far back the visual info was implemented...
set TheVisual ""
set ColorBits ""
if {! [ catch {set TheVisual [winfo visual .]}]}  {
  set visavail [winfo visualsavailable .]
  set l1 [string first $TheVisual $visavail]
  while {[string index $visavail $l1] != " "}  {
    incr l1
    }
  while {[string index $visavail $l1] == " "}  {
    incr l1
    }
  set l2 [string first "\}" [string range $visavail $l1 end]]
  incr l2 [expr $l1 -1]
  set ColorBits [string range $visavail $l1 $l2]
  }
  catch {set fileprobe [exec file -v]}



set InitFlag 0
set Debug 0
set Debugi 1
set Debugl 0
set DfltDir $Home
set CurDir $Home
set ExtDir "/tmp"
set WinList ""
set FLList ""
set ArcOnly 0
set TmpNo 0
set ArcWin 0
set DirWin 0
set ExtWin 0

set CldFlag 1
set CleFlag 1
set DseFlag 1
set SavOpt 0
set StdNames 1
set GnuLin 0
set ShnHeur 1
set FastClean 0
set MultView 0
set Vpn 0
set CompOpt 0
set ExtDirs 1

set OvWarn 1
set OvOpt 1
set ForceStat 0
set Desperation 1
set IgnITG 1
set NoProbe 0
set VDWarn 1
set ADWarn 1
set MDWarn 1
set EmUser $WhoIAm
set EmHost $WhereIAm

#  The shadow flag hack...
set MenuHelp 0
set ShDesperation $Desperation
set ShIgnITG $IgnITG
set ShNoProbe $NoProbe
set ShCompOpt $CompOpt

#  The context-sensitive help hack...
#  because we can't bind button-3 events to the menubuttons as they're
#  currently implemented, we have to do everything the hard way, pretending
#  that inactive buttons are greyed out.
set MainSelected 0

if {$TkVer <= 3.6} {
  set oldtkv36 1
  }  else {
  set oldtkv36 0
  }
#  Someday we'll put in support for old versions...maybe.
#  01/20/1996 - Oh, no we won't. Not since 8.0 is out - that old stuff's just too old now.
if {$oldtkv36} {
  puts "$PgmName version $TkzVer will not run under Tcl/Tk release $TclVer/$TkVer."
  exit
  }

ParseArgs

if {! $Windows && ! $Crippled}  {
  catch [exec mkdir $TempDir]
  }

#  See whether necessary pgms are present -
set NeededPgms "tar (Gnu-tar) zip gzip zcat compress"
set NeededPgmFlags "GotTar GotGtar GotZip GotGzip GotZcat GotCompress"
set GotPgms ""
set NoGotPgms ""

set NeededPgms2 "ar unarj unrar shorten bzip lha cpio"
set NeededPgmFlags2 "GotAr GotArj GotRar GotShn GotBzip GotLha GotCpio"
set GotPgms2 ""
set NoGotPgms2 ""

set sysinfo "$TempDir/TkzSysinfo"

#  The default viewer list -
set VNum 11
set VNames(1) "Xless"
set VBins(1) "xless"
#set VNames(2) "CRiSP"
#set VBins(2) "mcr"
set VNames(2) "Nedit"
set VBins(2) "nedit"
set VNames(3) "Textedit"
set VBins(3) "textedit"
set VNames(4) "Emacs"
set VBins(4) "emacs"
set VNames(5) "Bradley's Famous XV"
set VBins(5) "xv"
set VNames(6) "Netscape"
set VBins(6) "netscape"
set VNames(7) "Mosaic"
set VBins(7) "mosaic"
set VNames(8) "Arena"
set VBins(8) "arena"
set VNames(9) "TkZip"
set VBins(9) "TkZip"
set VNames(10) "Xhexedit"
set VBins(10) "Xhexed"
set VNames(11) "User defined"
set VBins(11) ""


if {$Crippled}  {
  set GotTar 0
  set GotGtar 0
  set GotZip 0
  set GotGzip 0
  set GotZcat 0
  set GotCompress 0
  set NoGotPgms "tar (Gnu-tar) zip gzip zcat compress"
  set NoGotPgms2 "ar unarj unrar shorten bzip"
  return 1
  }

#  Let's hope this catches most tars... 
#    we'll need user feedback on this one.
set NL "\n"
catch {set si [open $sysinfo a+]}

#  Add a couple of useful pieces of info...
#  catch {puts $si "\n================\nXserver probe response:\n    $tmp\n================\n"}
catch {puts $si "\n================\nWhitePixel value:\n    $WhitePixel\n================\n"}
catch {puts $si "\n================\nVisual:\n    $TheVisual  -  $ColorBits bits\n================\n"}
catch {puts $si "\n================\nTcl/Tk version:\n    $TclVer/$TkVer\n================\n"}
catch {puts $si "\n================\nFile probe response:\n    $fileprobe\n================\n"}

set rc [catch {exec tar > /dev/null} cc]
catch {puts $si "\n================\nTar probe response:\n    $cc\n================\n"}
if {[string first "tar" $cc] == 0 || [string first "Usage" $cc] != -1 || [string first "usage" $cc] != -1}  {
  set GotTar 1
  set GotPgms "tar"
  
  #  Test for Gnu Tar...
  set rc [catch {exec tar --version } cc]
  catch {puts $si "\n================\nGnu Tar probe response:\n    $cc\n================\n"}
  if {[string first "GNU" $cc] != -1 || [string first "Gnu" $cc] != -1}  {
    set GotGtar 1
    } else {
    set GotGtar 0
    }
  
  } else {
  set GotTar 0
  set GotGtar 0
  set NoGotPgms "tar"
  }
#  These guys are predictable & rational 
set rc [catch {set dummy [exec unzip -v ]} cc]
catch {puts $si "\n================\nUnZip probe response:\n    $cc\n================\n"}
if { [string first "UnZip" $cc] != -1 }  {
  set GotZip 1
  set GotPgms "$GotPgms zip"
  } else {
  set GotZip 0
  set NoGotPgms "$NoGotPgms zip"
  }
set rc [catch {exec gunzip -V > /dev/null} cc]
catch {puts $si "\n================\nGunzip probe response:\n    $cc\n================\n"}
if { [string first "gunzip" $cc] == 0 } {
  set GotGzip 1
  set GotPgms "$GotPgms gzip"
  } else {
  set GotGzip 0
  set NoGotPgms "$NoGotPgms gzip"
  }
set rc [catch {exec echo "$NL" | zcat -V > /dev/null} cc]
catch {puts $si "\n================\nZcat probe response:\n    $cc\n================\n"}
if {[string first "zcat" $cc] == 0 || [string first "Usage" $cc] != -1 || [string first "usage" $cc] != -1 || [string first "options" $cc] != -1}  {
  set GotZcat 1
  set GotPgms "$GotPgms zcat"
  } else {
  set GotZcat 0
  set NoGotPgms "$NoGotPgms zcat"
  }
set rc [catch {exec echo "$NL" | uncompress -V > /dev/null} cc]
catch {puts $si "\n================\nCompress probe response:\n    $cc\n================\n"}
if {[string first "ompress" $cc] == 1 || [string first "ompress" $cc] == 3 || [string first "sage" $cc] != -1 || [string first "ptions" $cc] != -1}  {
  set GotCompress 1
  set GotPgms "$GotPgms compress"
  }  else  {
  set GotCompress 0
  set NoGotPgms "$NoGotPgms compress"
  }
set GotPgmFlags "$GotTar $GotZip $GotGzip $GotZcat $GotCompress"

#catch {puts $si "\n================\nArchive Programs Found:\n    $GotPgms\nArchive Programs Not Found:\n    $NoGotPgms\n================\n"}
#catch {close $si}



#  Test for the new types...
set GotPgms2 ""
set rc [catch {exec ar -V} cc]
catch {puts $si "\n================\nAr probe response:\n    $cc\n================\n"}
if {[string first "ar " $cc] != -1 || [string first "usage" $cc] != -1 || [string first "ersion" $cc] != -1}  {
  set GotAr 1
  set GotPgms2 "$GotPgms2 ar"
  }  else  {
  set GotAr 0
  set NoGotPgms2 "$NoGotPgms2 ar"
  }
set rc [catch {exec unarj} cc]
catch {puts $si "\n================\nArj probe response:\n    $cc\n================\n"}
if {[string first "UNARJ" $cc] != -1 || [string first "usage" $cc] != -1}  {
  set GotArj 1
  set GotPgms2 "$GotPgms2 arj"
  }  else  {
  set GotArj 0
  set NoGotPgms2 "$NoGotPgms2 arj"
  }
set rc [catch {exec unrar} cc]
catch {puts $si "\n================\nRar probe response:\n    $cc\n================\n"}
if {[string first "UNRAR" $cc] != -1 || [string first "usage" $cc] != -1}  {
  set GotRar 1
  set GotPgms2 "$GotPgms2 rar"
  }  else  {
  set GotRar 0
  set NoGotPgms2 "$NoGotPgms2 rar"
  }
set rc [catch {exec shorten -h} cc]
catch {puts $si "\n================\nShorten probe response:\n    $cc\n================\n"}
if {[string first "shorten:" $cc] == 0 || [string first "usage" $cc] != -1}  {
  set GotShn 1
  set GotPgms2 "$GotPgms2 shorten"
  }  else  {
  set GotShn 0
  set NoGotPgms2 "$NoGotPgms2 shorten"
  }
set rc [catch {exec bzip -h} cc]
catch {puts $si "\n================\nbzip probe response:\n    $cc\n================\n"}
if {[string first "BZIP" $cc] != -1 || [string first "usage" $cc] != -1}  {
  set GotBzip 1
  set GotPgms2 "$GotPgms2 bzip"
  }  else  {
  set GotBzip 0
  set NoGotPgms2 "$NoGotPgms2 bzip"
  }
set rc [catch {exec lha } cc]
catch {puts $si "\n================\nLHarc probe response:\n    $cc\n================\n"}
if {[string first "LHarc" $cc] != -1 || [string first "usage" $cc] != -1}  {
  set GotLha 1
  set GotPgms2 "$GotPgms2 lha"
  }  else  {
  set GotLha 0
  set NoGotPgms2 "$NoGotPgms2 lha"
  }
set rc [catch {exec cpio } cc]
catch {puts $si "\n================\ncpio probe response:\n    $cc\n================\n"}
if {[string first " cpio " $cc] != -1 || [string first "Usage" $cc] != -1}  {
  set GotCpio 1
  set GotPgms2 "$GotPgms2 cpio"
  }  else  {
  set GotCpio 0
  set NoGotPgms2 "$NoGotPgms2 cpio"
  }

set GotPgmFlags2 "$GotAr $GotArj $GotRar $GotShn $GotBzip"
catch {puts $si "\n================\nArchive Programs Found:\n    $GotPgms $GotPgms2\nArchive Programs Not Found:\n    $NoGotPgms $NoGotPgms2\n================\n"}
catch {close $si}


#  OK, all defaults have been set - here's where we look for user config 
LoadConfig
set NewCache $CacheDir
set CacheDir $Home
CleanDirs
set CacheDir $NewCache
if {$CacheDir != $Home}  {
  SetCacheDir
  set sysinfo "$TempDir/TkzSysinfo"
  CleanDirs
  }

#  If we couldn't check visual, don't try this stuff...
if {$ColorBits == ""}  {
  set ColorHack 0
  }
if {$ColorHack}  {
  if {$ColorBits > 16}  {
    set TBg        "LightGrey MediumSpringGreen DarkSeaGreen SteelBlue NavajoWhite DarkSlateGrey MistyRose4 red red   yellow RosyBrown CadetBlue sienna ForestGreen DarkSalmon IndianRed4 turquoise1"
    set TButBg     "NavajoWhite NavajoWhite NavajoWhite NavajoWhite NavajoWhite NavajoWhite NavajoWhite NavajoWhite NavajoWhite NavajoWhite NavajoWhite NavajoWhite NavajoWhite NavajoWhite NavajoWhite NavajoWhite NavajoWhite"
    }
  }

return 1
}


#----------------------------------------------------
#  SetCacheDir   --  Switch to a new Cache Directory,
#    creating it if necessary
#----------------------------------------------------
proc SetCacheDir {} {
global TempDir CacheDir MyPid PgmName ErrArgs

set oldtmp $TempDir
set newtmp "$CacheDir/.TkZip$MyPid"
#set TempDir "$CacheDir/.TkZip$MyPid"
if {! [file exists $CacheDir]}  {
set rc [catch { exec mkdir $CacheDir } cc]
  if   [catch { exec mkdir $CacheDir }]  {
#    puts "$PgmName  --  couldn't create $CacheDir for cache directory."
#    puts "$PgmName  --  continuing to used old cache directory  -  $oldtmp."
    set ErrArgs "$oldtmp $CacheDir"
    GErrMsgBox 81
    return -1
    }
  }
catch [exec mkdir $newtmp]
catch [exec cp $oldtmp/TkzSysinfo $newtmp/TkzSysinfo]
catch [exec cp -rf $oldtmp.* $newtmp]
#set sysinfo "TkzSysinfo"
catch [exec rm -rf $oldtmp]


set TempDir $newtmp

return 1
}


#----------------------------------------------------
#  ChangeCacheDir   --  Dialogue for changing the 
#    cache directory
#----------------------------------------------------
proc ChangeCacheDir {} {
global TempDir CacheDir MyPid PgmName ErrArgs MenuHelp
global MainBg MainButBg WhoBg ArcWin WinList

if {$MenuHelp}  {
  set MenuHelp 0
  ShowHelp 42
  return 1
  }

#--------------------------------------
if {$WinList != ""}  {
  set ErrArgs "$TempDir"
  GErrMsgBox 80
  return 1
  }

set WBg $MainBg
set WButBg $MainButBg
set EntBg "bisque"
set WFg "black"

set owner "main"

#-------------------------------------------------------------------
#  Make some unique names for us...
#incr ArcWin
set thiswin "chgc000"
set WinName ".$thiswin"
set owner $thiswin

set dirname "/"


#set arcn "arcname$thiswin"
#global $arcn
#set $arcn $arcname
#set atype "ArcFno$owner"
#global $atype
#set type [set $atype]


if [catch {toplevel $WinName}] {
  raise $WinName
  } else {
#  Build the window...
  set arctitle "Select New Cache Directory"
  wm title $WinName $arctitle
  set topf [frame $WinName.top -bg $WBg -highlightbackground $WBg]
  set buttons [frame $topf.but -bg $WBg -highlightbackground $WBg]
  set namef [frame $WinName.top.namef -bg $WBg -highlightbackground $WBg]

  set cmd "ChangeCacheDir2 $owner"
  button $buttons.add2arc -text "Change Cache" -command $cmd \
    -bg $WButBg -highlightbackground $WButBg
set cmd "destroy $WinName"
set cmd "KillCacheWin $thiswin"
  button $buttons.quit -text "Cancel" -command $cmd \
    -bg $WButBg -highlightbackground $WButBg
#  Gotta intercept wm killing the window with this command too
  wm protocol $WinName "WM_DELETE_WINDOW" $cmd
  wm protocol $WinName "WM_SAVE_YOURSELF" $cmd

  label $namef.where -text "   Directory:  " -relief flat -bg $MainBg
  entry $namef.dir -text " " -relief sunken -bg $WhoBg -width 30 \
  -font "-*-fixed-bold-*-*-*-*-*-*-*-*-*-*-1" -state disabled

  pack $buttons.add2arc $buttons.quit -side left
  pack $namef.where $namef.dir -side left -expand no


#  Now build a file selection list for directory to create in & filename...
  set flbody [ frame $WinName.body  -bg $WBg -highlightbackground $WBg]
  set body $thiswin.body

  set stuff [BuildDirList "$body"]

  pack $flbody -anchor w -fill x -side bottom -fill both -expand yes
  
  pack $namef -side bottom -anchor center 
  pack $buttons -side bottom
  
  pack $topf -side bottom -anchor center -expand yes -fill x

  set cradir "CraDir$body"
  global $cradir
  set $cradir $dirname
  set cmd "UpdCraDir $body"
  bind $flbody.list1.dirlist <Double-1> $cmd
  $flbody.list1.dirlist configure -selectmode extended
  $flbody.list2.arclist configure -selectmode extended
  set cmd "UpdCraDir2 $thiswin"
  bind $namef.dir <Return> $cmd


  $namef.dir configure -textvariable $cradir
  set $cradir [UpdDirList "$body" "$dirname"]


  }

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

return 1 	
}


#----------------------------------------------------
#  ChangeCacheDir2   --  OK, do it. 
#----------------------------------------------------
proc ChangeCacheDir2 {owner} {
global TempDir CacheDir MyPid PgmName ErrArgs MenuHelp FLList
set thisproc "ChangeCacheDir2"

set body "$owner.body"
set cradir "CraDir$body"
global $cradir
set newdir [set $cradir]
set olddir $CacheDir
set CacheDir $newdir
set rc [SetCacheDir]

set oldcache $TempDir
set newcache "$newdir/.TkZip$MyPid"

KillCacheWin $owner
RefDirs "$olddir"
RefDirs "$newdir"
if {$rc != -1}  {
  set ErrArgs "$oldcache $newcache"
  GErrMsgBox 79
  }
return 1 	
}


#-------------------------------------------------
#  KillCacheWin   --  Deal with cmd line args
#-------------------------------------------------
proc KillCacheWin {owner} {
global FLList

set body "$owner.body"

PluckFromList $body "FLList"
destroy .$owner

}


#-------------------------------------------------
#  ParseArgs   --  Deal with cmd line args
#-------------------------------------------------
proc ParseArgs {} {
global argc argv PgmName TkzVer Debug Debugon CurDir InitFile
set InitFile ""

if {$argc > 0} {
  set argnum [expr $argc - 1]
  set curarg 0
  while {$curarg < $argc} {
    set thisarg [lindex $argv $curarg]

    switch -exact -- [lindex $argv $curarg] {
      "-v"           -
      "--version"    {
         puts "$PgmName version $TkzVer"
	 exit
         }

      "--debug"      {
         set Debugon 1
         }

      default      {
         if {[string first "--"  $thisarg]  !=  0}  {
           set lsl [string last "/" $thisarg]
           if {$lsl < 0}  {
             set CurDir [pwd]
             set InitFile $thisarg
             }
           if {$lsl == 0}  {
             set CurDir "/"
             set InitFile [string range $thisarg 1 end]
             }
           if {$lsl > 0}  {
             set CurDir [string range $thisarg 0 [expr $lsl - 1]]
             set InitFile [string range $thisarg [expr $lsl + 1] end]
             }
           }
         #  Otherwise, just ignore something that looks like a pgm switch arg
         }
      }
    incr curarg
    }
  }

return 1
}


#-------------------------------------------------
#  CleanDirs   --  Clean up any stale files/dirs
#-------------------------------------------------
proc CleanDirs {} {
global Home CldFlag CleFlag TempDir CacheDir

if {! $CldFlag && !$CleFlag}  {
  return 1
  }

set cacheroot $CacheDir
set tkzdirs ""
set tkzerrs ""
set ignl [string length "$cacheroot/.TkZip"]
set ignl2 [string length "$cacheroot/TkzErr"]
catch {set tkzdirs [glob $cacheroot/.TkZip*]}
catch {set tkzerrs [glob $cacheroot/TkzErr*]}
set pids ""
if [ catch {set in [open [ concat "|ps"] ]} ]  {
  return 1
  }
set lno 0
while  { [ gets $in line ] > -1 } {
  if {$lno == 0}  {
    incr lno
    continue
    }
  set line [string trim $line]
  set pidend [string first " " $line]
  set pid [string trim [string range $line 0 $pidend]]
  set pids "$pids $pid"
  }
catch { close $in }

set pids "$pids "
if {$CldFlag}  {
  foreach file "$tkzdirs"  {
    if {[file isdirectory $file]}  {
      set pid [string range $file $ignl end]
      set pid " $pid "
      if {[string first $pid $pids] != -1}  {
        }  else  {
        catch [exec rm -rf $file]
        }
      }
    }
  }
if {$CleFlag}  {
  foreach file "$tkzerrs"  {
    set pid [string range $file $ignl end]
    set pid " $pid "
    if {[string first $pid $pids] != -1}  {
      }  else  {
      catch [exec rm -f $file]
      }
    }
  }

return 1
}


#----------------------------------------------------------
#  LoadConfig  --  Load user's config, if any - 
#----------------------------------------------------------
proc LoadConfig {} {
global PgmName Home ViewOpts VNames VBins VNum
global EmUser EmHost CacheDir
global Crippled InitFlag

if {$Crippled}  {
  return 1
  }

set ViewOpts 0
set optfile "$Home/.TkZip.rc"
if [ catch {set of [open $optfile r]} ]  {
  SaveConfig
  set InitFlag 1
  return 1
  }

while {[ gets $of line ] > -1}  {
  #  First, strip comments... 
  set ti [string first "#" $line]
  if {$ti != -1}  {
    if {$ti == 0}  {
      set line ""
      }  else  {
      incr ti -1
      set line [string range $line 0 $ti]
      }
    }
  set line [string trim $line]

  #  Now, identify our stuff... 
  if {[string first $PgmName $line] == 0}  {
    set ti [string first "*" $line]
    incr ti
    set line [string range $line $ti end]
    set ti [string first ":" $line]
    if {$ti > 0}  {
      set opt [string trim [string range $line 0 [expr $ti - 1] ] ]
      incr ti
      set val [string trim [string range $line $ti end] ]
      SetConfigOpt $opt $val
      #  End - we have an option name... 
      }
    #  End - it's one of ours... 
    }
  } 
catch [close $of]
if {$ViewOpts != 0}  {
  incr ViewOpts
  set VNum $ViewOpts
  set VNames($VNum) "User defined"
  set VBins($VNum) ""
  }
unset ViewOpts

return 1
}



#--------------------------------------------------
#  SetConfigOpt - Set an option 
#--------------------------------------------------
proc SetConfigOpt {opt val} {
global PgmName Home
global EmUser EmHost
global ViewOpts OvWarn OvOpt VNames VBins VNum CldFlag CleFlag DseFlag SavOpt
global StdNames GnuLin ShnHeur ColorHack FastClean MultView Vpn CompOpt ArcOnly
global CacheDir 

#  First the special case of viewers... 
#  They can really call it Viewer3200-xyz-anyoldstuff...  
if {[string first "Viewer" $opt] == 0}  {
  if {$ViewOpts == 0}  {
    unset VNames
    unset VBins
    }
  incr ViewOpts
#  set opti [string range $opt 6 end]
#  set opti $ViewOpts
  set opt1 "Viewer"
  set ti [string first ":" $val]
  set val1 [string trim [string range $val 0 [expr $ti - 1] ] ]
  set val1 [string trim $val1 "\""]
  set val2 [string trim [string range $val [expr $ti + 1] end] ]
  set VNames($ViewOpts) $val1
  set VBins($ViewOpts) $val2

  }  else  {
  switch $opt        {

    "OvWarn"         {
        #  Since OvOpt got inverted, & they're mutually exclusive - these 2 must be the same. 
        set OvWarn $val
	if {$OvWarn == 1}  {
	  set OvOpt 1
	  }
        }

    "OvOpt"         {
        set OvOpt $val
	if {$OvOpt == 0}  {
	  set OvWarn 0
	  }
        }

    "Desperation"         {
        set Desperation $val
        }

    "IgnITG"         {
        set IgnITG $val
        }

    "NoProbe"         {
        set NoProbe $val
        }

    "EmUser"         {
        set EmUser $val
        }

    "EmHost"         {
        set EmHost $val
        }

    "CldFlag"         {
        set CldFlag $val
        }

    "CleFlag"         {
        set CleFlag $val
        }

    "DseFlag"         {
        set DseFlag $val
        }

    "SavOpt"         {
        set SavOpt $val
        }

    "StdNames"         {
        set StdNames $val
        }

    "GnuLin"         {
        set GnuLin $val
        }

    "ShnHeur"         {
        set ShnHeur $val
        }

    "ColorHack"         {
        set ColorHack $val
        }

    "FastClean"         {
        set FastClean $val
        }

    "MultView"         {
        set MultView $val
        }

    "Vpn"         {
        set Vpn $val
        }

    "CompOpt"         {
        set CompOpt $val
        }

    "CacheDir"         {
        set CacheDir $val
        }

    "ArcOnly"         {
        set ArcOnly $val
        }

    default         {
        }

    }
    #  End switch...  
  }


return 1
}




#--------------------------------------------------
#  SaveConfig  --  Save user's config - 
#--------------------------------------------------
proc SaveConfig {} {
global PgmName Home
global OvWarn OvOpt Desperation IgnITG NoProbe VNames VBins VNum
global EmUser EmHost MenuHelp CldFlag CleFlag DseFlag SavOpt
global StdNames GnuLin ShnHeur ColorHack FastClean MultView Vpn CompOpt
global CacheDir ArcOnly 

if {$MenuHelp}  {
  set MenuHelp 0
  ShowHelp 14
  return 1
  }

set optfile "$Home/.TkZip.rc"
catch {set of [open $optfile w]}

catch {puts $of "$PgmName*OvWarn:              $OvWarn "}
catch {puts $of "$PgmName*OvOpt:               $OvOpt "}
catch {puts $of "$PgmName*Desperation:         $Desperation "}
catch {puts $of "$PgmName*IgnITG:              $IgnITG "}
catch {puts $of "$PgmName*NoProbe:             $NoProbe "}
catch {puts $of "$PgmName*EmUser:              $EmUser "}
catch {puts $of "$PgmName*EmHost:              $EmHost "}
catch {puts $of "$PgmName*CldFlag:             $CldFlag "}
catch {puts $of "$PgmName*CleFlag:             $CleFlag "}
catch {puts $of "$PgmName*DseFlag:             $DseFlag "}
catch {puts $of "$PgmName*SavOpt:              $SavOpt "}
catch {puts $of "$PgmName*StdNames:            $StdNames "}
catch {puts $of "$PgmName*GnuLin:              $GnuLin "}
catch {puts $of "$PgmName*ShnHeur:             $ShnHeur "}
catch {puts $of "$PgmName*ColorHack:           $ColorHack "}
catch {puts $of "$PgmName*FastClean:           $FastClean "}
catch {puts $of "$PgmName*MultView:            $MultView "}
catch {puts $of "$PgmName*Vpn:                 $Vpn "}
catch {puts $of "$PgmName*CompOpt:             $CompOpt "}
catch {puts $of "$PgmName*CacheDir:            $CacheDir "}
catch {puts $of "$PgmName*ArcOnly:             $ArcOnly "}

set i 1
while {$i < $VNum}  {
  puts $of "$PgmName*Viewer$i: \"$VNames($i)\" : $VBins($i) "
  incr i
  }

catch [close $of]

return 1
}




#-------------------------------------------------
#  Build MainFrame  --  Build the main window
#-------------------------------------------------
proc BuildMainFrame {} {
global whohdr timehdr TkzVer Copy PgmName WhoBg MainButBg MainBg
global OsName OsVer CurDir Debug Debugon TempDir ErrArgs
global Timehdr ViewButtons FLList
global ArcOnly OvWarn OvOpt ForceStat IgnITG Desperation NoProbe MainSelected
global VDWarn ADWarn MDWarn CldFlag CleFlag DseFlag SavOpt StdNames GnuLin 
global ShnHeur ColorHack FastClean MultView Vpn CompOpt ExtDirs
global Windows Plugin Crippled MainWhere2



if {$Plugin}  {
  DieInPlugin
  return -1
  }

set Timehdr ""
UpdTime
set ViewButtons ""
#  The fixed portion
set mainf "main"
frame .main -bg $MainBg
#  Gotta intercept wm killing the window
set cmd "FinalExit"
wm protocol . "WM_DELETE_WINDOW" $cmd
wm protocol . "WM_SAVE_YOURSELF" $cmd

set cdvar "CurDir$mainf"
global $cdvar
set $cdvar $CurDir
set MainWhere2 $CurDir

#  Identify ourselves
frame .main.f1 -highlightbackground $MainBg -bg $MainBg -bd 8
frame .main.f1a -highlightbackground $MainBg -bg $MainBg -bd 8
set pgmhdr "release $TkzVer    $Copy"
set whohdr "$OsName $OsVer"
set whohdr "$PgmName is running under $whohdr"
#set timehdr [ exec date ]
label .main.f1.hdr1 -text $PgmName -relief flat -width 5 -bg $MainBg \
      -font "-*-*-bold-*-*-*-*-300-*-*-*-*-iso8859-1"
label .main.f1.hdr2 -text $pgmhdr -relief flat -width 56 -bg $MainBg
label .main.f1a.hdr3 -text $whohdr -relief sunken -width 36 -bg $WhoBg
label .main.f1a.hdr4 -textvariable Timehdr -relief sunken -width 30 -bg $WhoBg
pack .main.f1.hdr1 .main.f1.hdr2 -side left
pack .main.f1a.hdr3 .main.f1a.hdr4 -side left



#  The main ctl buttons
frame .main.f2 -highlightbackground $MainBg -bg $MainBg
button .main.f2.but1 -text "Exit" -bg $MainButBg -highlightbackground $MainBg \
  -relief groove -bd 3 -padx 12 -command {FinalExit} 
label .main.f2.s1 -width 3
label .main.f2.s2 -width 1
label .main.f2.s3 -width 8 -relief flat -bd 0 -highlightbackground $MainBg -bg $MainBg
label .main.f2.s4 -width 1

menubutton .main.f2.but2 -text "File" \
  -bg $MainButBg -highlightbackground $MainBg -relief groove -bd 3 -padx 12
menu .main.f2.but2.m1 -bg $MainButBg -disabledforeground $MainBg
.main.f2.but2.m1 add command -label "Exit" -command {FinalExit}
#  Fake disabled button
.main.f2.but2.m1 add command -label "New Archive         " -command {CreateArc "main" "dummy" "dummy"} -state normal
.main.f2.but2.m1 add command -label "Open Archive" \
  -command {SetupView "main"}
#  Fake disabled button
.main.f2.but2.m1 add command -label "Delete Archive      " -command {DelArc "main"} -state normal \
  -foreground PowderBlue
.main.f2.but2.m1 add command -label "Show System Info" -command {ShowSysInfo}
.main.f2.but2 configure -menu .main.f2.but2.m1
# Disable the placeholders...
.main.f2.but2.m1 entryconfigure 3 -state normal \
  -foreground PowderBlue

frame .main.f2.mbf1 -highlightbackground $MainBg -bg $MainBg
menubutton .main.f2.mbf1.but4 -text "Options" \
  -bg $MainButBg -highlightbackground $MainBg -relief groove -bd 3 -padx 12
menu .main.f2.mbf1.but4.men1 -bg $MainButBg -disabledforeground $MainBg
.main.f2.mbf1.but4.men1 add checkbutton -label "Show Archives Only" -command {ToggleArcOpt "main"} \
  -variable ArcOnly
.main.f2.mbf1.but4.men1 add checkbutton -label "Warn of Overwrites" -command {KillOvOpt} -variable OvWarn -state normal
.main.f2.mbf1.but4.men1 add checkbutton -label "Never Overwrite Existing Files" -command {KillOvWarn} -variable OvOpt \
  -offvalue 1 -onvalue 0 -state normal
.main.f2.mbf1.but4.men1 add checkbutton -label "Ignore Gnu \"trailing garbage\" Message" -command {CheckHelp 11} \
  -variable IgnITG -state normal
.main.f2.mbf1.but4.men1 add checkbutton -label "Improved Tar Detection" -command {CheckHelp 12} \
  -variable Desperation -state normal
.main.f2.mbf1.but4.men1 add checkbutton -label "Don't Probe Compressed Files" -command {CheckHelp 13} \
  -variable NoProbe -state normal
.main.f2.mbf1.but4.men1 add checkbutton -label "Warn on Viewer Delete" -command {CheckHelp 27} \
  -variable VDWarn -state normal
.main.f2.mbf1.but4.men1 add checkbutton -label "Warn on Archive Delete" -command {CheckHelp 28} \
  -variable ADWarn -state normal
.main.f2.mbf1.but4.men1 add checkbutton -label "Warn on Member Delete" -command {CheckHelp 29} \
  -variable MDWarn -state normal
.main.f2.mbf1.but4.men1 add checkbutton -label "Clean Old Temp Files" -command {CheckHelp 30} \
  -variable CldFlag -state normal
.main.f2.mbf1.but4.men1 add checkbutton -label "Clean Old Error Files" -command {CheckHelp 31} \
  -variable CleFlag -state normal
.main.f2.mbf1.but4.men1 add checkbutton -label "Don't Save Error Files" -command {CheckHelp 32} \
  -variable DseFlag -state normal

.main.f2.mbf1.but4.men1 add checkbutton -label "Save Options on Exit" -command {CheckHelp 33} \
  -variable SavOpt -state normal
.main.f2.mbf1.but4.men1 add checkbutton -label "Use Standard Name Extensions" -command {CheckHelp 34} \
  -variable StdNames -state normal
.main.f2.mbf1.but4.men1 add checkbutton -label "GNU/Linux tgz convention" -command {CheckHelp 35} \
  -variable GnuLin -state normal
.main.f2.mbf1.but4.men1 add checkbutton -label "Shorten Heuristic (experimental)" -command {CheckHelp 36} \
  -variable ShnHeur -state normal
.main.f2.mbf1.but4.men1 add checkbutton -label "Disable Colormap Hack" -command {CheckHelp 37} \
  -variable ColorHack -state normal -offvalue 1 -onvalue 0

menu .main.f2.mbf1.but4.men1.mormen -bg $MainButBg -disabledforeground $MainBg
#  Note:  the CheckHelp kluge doesn't work...
.main.f2.mbf1.but4.men1 add cascade -label "(More)" -menu .main.f2.mbf1.but4.men1.mormen -command {CheckHelp 99}
.main.f2.mbf1.but4.men1.mormen add checkbutton -label "Fast-Clean Viewer Files" -command {CheckHelp 38} \
  -variable FastClean -state normal
.main.f2.mbf1.but4.men1.mormen add checkbutton -label "View Multiple Files" -command {CheckHelp 39} \
  -variable MultView -state normal
.main.f2.mbf1.but4.men1.mormen add checkbutton -label "Use Pathnames when Viewing" -command {CheckHelp 41} \
  -variable Vpn -state normal
# .main.f2.mbf1.but4.men1.mormen add checkbutton -label "Allow Extract of Directories" -command {CheckHelp 43} \
#   -variable ExtDirs -state normal

#  Needs Help...
menu .main.f2.mbf1.but4.men1.mormen.cmpomen -bg $MainButBg -disabledforeground $MainBg
.main.f2.mbf1.but4.men1.mormen add cascade -label "Compression Options" -menu .main.f2.mbf1.but4.men1.mormen.cmpomen 
.main.f2.mbf1.but4.men1.mormen.cmpomen add radiobutton -label "Default" -command {CheckHelp 40} \
  -variable CompOpt -value 0 -state normal
.main.f2.mbf1.but4.men1.mormen.cmpomen add radiobutton -label "Max Speed" -command {CheckHelp 40} \
  -variable CompOpt -value 1 -state normal
.main.f2.mbf1.but4.men1.mormen.cmpomen add radiobutton -label "Medium" -command {CheckHelp 40} \
  -variable CompOpt -value 6 -state normal
.main.f2.mbf1.but4.men1.mormen.cmpomen add radiobutton -label "Max Compression" -command {CheckHelp 40} \
  -variable CompOpt -value 9 -state normal

.main.f2.mbf1.but4.men1.mormen add command -label "Change Cache Directory" -command {ChangeCacheDir} \
  -state normal



# .main.f2.mbf1.but4.men1 add checkbutton -label "Preserve Absolute Pathnames" -command {} -state disabled
# .main.f2.mbf1.but4.men1 add checkbutton -label "Always Show Extract % Done" -variable ForceStat -state disabled
# .main.f2.mbf1.but4.men1 add checkbutton -label "Use Internal Viewer (when possible)" -command {} -state disabled

if {$Debugon}  {
  .main.f2.mbf1.but4.men1 add checkbutton -label "Debug Mode (undocumented)" -variable Debug -state normal
  menu .main.f2.mbf1.but4.men1.dbmen -bg $MainButBg -disabledforeground $MainBg
  .main.f2.mbf1.but4.men1 add cascade -label "Debug Options" -menu .main.f2.mbf1.but4.men1.dbmen
  .main.f2.mbf1.but4.men1.dbmen add checkbutton -label "Interactive" -variable Debugi -state normal
  .main.f2.mbf1.but4.men1.dbmen add checkbutton -label "Logging" -variable Debugl -state normal
  }
.main.f2.mbf1.but4.men1 add command -label "Save Options" -command {SaveConfig} -state normal
#
#  Remove "Preserve Pathnames...?" from the general menu...
#  Add sub menu for type-specific options
#
#  On the other hand...just how many of these special options does anyone REALLY
#  need? I certainly don't need them.
#  (Shorten might be a special case, but who's gonna use it?)
#
#  menu .main.f2.mbf1.but4.men1.asopts
#  .main.f2.mbf1.but4.men1 add cascade -label "Archive Type-Specific Options" \
#    -menu .main.f2.mbf1.but4.men1.asopts

#  menu .main.f2.mbf1.but4.men1.asopts.taropts
#  menu .main.f2.mbf1.but4.men1.asopts.zipopts
#  menu .main.f2.mbf1.but4.men1.asopts.gzopts
#  menu .main.f2.mbf1.but4.men1.asopts.shnopts

#  .main.f2.mbf1.but4.men1.asopts add cascade -label "Tar Options" \
#    -menu .main.f2.mbf1.but4.men1.asopts.taropts
#  .main.f2.mbf1.but4.men1.asopts add cascade -label "Zip Options" \
#    -menu .main.f2.mbf1.but4.men1.asopts.Zipopts
#  .main.f2.mbf1.but4.men1.asopts add cascade -label "Gzip Options" \
#    -menu .main.f2.mbf1.but4.men1.asopts.gzopts
#  .main.f2.mbf1.but4.men1.asopts add cascade -label "Shorten Options" \
#    -menu .main.f2.mbf1.but4.men1.asopts.shnopts
#
#
#
#

.main.f2.mbf1.but4 configure -menu .main.f2.mbf1.but4.men1

menubutton .main.f2.but5 -text "Help" \
  -bg $MainButBg -highlightbackground $MainBg -relief groove -bd 3 -padx 12
menu .main.f2.but5.men1 -bg $MainButBg
.main.f2.but5.men1 add command -label "About" -command {About}
.main.f2.but5.men1 add command -label "Help" -command {ShowHelp 1}
.main.f2.but5.men1 add command -label "Register $PgmName" -command {Register 1}
.main.f2.but5.men1 add command -label "Bug Report/Comment" -command {Register 2}
.main.f2.but5 configure -menu .main.f2.but5.men1


pack .main.f2.mbf1.but4
pack .main.f2.but1 .main.f2.but2 .main.f2.mbf1 .main.f2.but5 -side left

frame .main.f3 -highlightbackground $MainBg -bg $MainBg
label .main.f3.where -text "Current Directory:  " -relief flat -bg $MainBg -width 20 
entry .main.f3.s1 -text " " -relief sunken -bg $WhoBg -width 40 -textvariable $cdvar \
  -font "-*-fixed-bold-*-*-*-*-*-*-*-*-*-*-1"

pack .main.f3.where .main.f3.s1 -side left -fill x -anchor center


pack .main.f1 -fill x -anchor center
pack .main.f1a -anchor center
pack .main.f2  -anchor center
pack .main.f3 -fill x -anchor center


#  Now build a file selection list...

set stuff [BuildDirList "$mainf"]

bind .main.f3.s1 <Return> {catch {set CurDir [ .main.f3.s1 get ]};  \
    UpdDirList "main" "$CurDir"; 
    }
bind .main.list1.dirlist <Double-1> { UpdMainDir "main" }
bind .main.list2.arclist <Double-1> { SetupView "main" }

bind .main.list1.dirlist <1> {MainSelect1} 
bind .main.list2.arclist <1> {MainSelect} 

#  New Help bindings...
#  Hmm...this doesn't work very well with menus...
bind .main.f2.but1 <3> {ShowHelp 01}
bind .main.f2.but2 <3> {ShowHelp 02a}
bind .main.f2.mbf1.but4 <3> {ShowHelp 07}
bind .main.f2.but5 <3> {ShowHelp 15}
bind .main.f2.but2.m1 <1> {UnSetHelp}
bind .main.f2.but2.m1 <3> {SetHelp}
bind .main.f2.mbf1.but4.men1 <1> {UnSetHelp}
bind .main.f2.mbf1.but4.men1 <3> {SetHelp}
bind .main.f2.mbf1.but4.men1.mormen <1> {UnSetHelp}
bind .main.f2.mbf1.but4.men1.mormen <3> {SetHelp}
bind .main.f2.mbf1.but4.men1.mormen.cmpomen <1> {UnSetHelp}
bind .main.f2.mbf1.but4.men1.mormen.cmpomen <3> {SetHelp}
bind .main.f2.but5.men1 <1> {UnSetHelp}
bind .main.f2.but5.men1 <3> {SetHelp}

UpdDirList "main" "$CurDir" 
# pack .main.list1 .main.list2 -side left -fill both -expand yes

pack .main -fill both -expand yes




return 1
}

#-----------------------------------------------------------------------------
#  UpdMainDir  -   Update the main directory list - removed from ancient 
#      inline code bound to double click - finally  
#-----------------------------------------------------------------------------
proc UpdMainDir {owner}  {
global MainSelected

set arcbody ".$owner"
set l1 [$arcbody.list1.dirlist curselection]
if {$l1 == ""}  {
  return 1
  }
set dirn [$arcbody.list1.dirlist get $l1]
$arcbody.f2.but2.m1 entryconfigure 3 -foreground PowderBlue
$arcbody.f2.but2.m1 entryconfigure 4 -foreground PowderBlue
set MainSelected 0
UpdDirList "$owner" "$dirn"

return 1
}

#-----------------------------------------------------------------------------
#  UpdTime  -   Update the date/time display occasionally  
#-----------------------------------------------------------------------------
proc UpdTime {}  {
global Timehdr
global Windows Plugin Crippled

if {! $Crippled}  {
  set Timehdr [exec date]
  after 27000 [list UpdTime ]
  }  else  {
  set Timehdr "Can't read time"
  }

return
}


#-----------------------------------------------------------------------------
#  KillOvOpt  -  if Warn-of-overwrites, turn off Never-overwrite
#    - remember, OvOpt's on-off values are inverted
#-----------------------------------------------------------------------------
proc KillOvOpt {}  {
global OvWarn OvOpt MenuHelp

if {$MenuHelp}  {
  set MenuHelp 0
  set OvWarn [ToggleOpt "$OvWarn"]
  ShowHelp 09
  return 1
  }

if {$OvWarn}  {
  set OvOpt 1
  }

return 1
}

#-----------------------------------------------------------------------------
#  KillOvWarn  -  if Never-overwrite, turn off Warn-of-overwrites
#-----------------------------------------------------------------------------
proc KillOvWarn {}  {
global OvWarn OvOpt MenuHelp

if {$MenuHelp}  {
  set MenuHelp 0
  set OvOpt [ToggleOpt "$OvOpt"]
  ShowHelp 10
  return 1
  }

if {! $OvOpt}  {
  set OvWarn 0
  }

return 1
}


#-----------------------------------------------------------------------------
#  DieInPlugin  --  Can't run in the plugin yet
#-----------------------------------------------------------------------------
proc DieInPlugin {}  {
global TempDir
global PgmName Windows Plugin Crippled

text .dead -bg AntiqueWhite -fg red -wrap word -width 72 -height 12
pack .dead
.dead tag configure deadfont -font -*-Times-bold-r-*-*-*-140-*-*-*-*-iso8859-1
.dead tag configure italic -font -*-Times-*-i-*-*-*-140-*-*-*-*-iso8859-1 -justify center
.dead tag configure deadhead -font -*-Times-bold-r-*-*-*-180-*-*-*-*-iso8859-1 \
  -justify center
.dead insert end "\n"
.dead insert end "Oops!" deadhead
.dead insert end "\n(Didn't we tell you not to try to run this under the Plugin?)\n" italic
.dead insert end "    $PgmName cannot run under the Plugin at present, because the standard\
  safeTcl security policy doesn't allow for creation of menu widgets (because\
  they're top-level windows). Well,\
  $PgmName is just full of menus. Sorry.\n    We're working on a Plugin-compatible\
  version for online demos, but it's not really a top priority. We trust that\
  most of our potential users would rather see useful function\
  than marketing fluff." deadfont
.dead configure -state disabled

return 1
exit
}


#-----------------------------------------------------------------------------
#  FinalExit  --  Clean up and get out
#-----------------------------------------------------------------------------
proc FinalExit {}  {
global TempDir
global Windows Plugin Crippled MenuHelp SavOpt

if {$MenuHelp}  {
  set MenuHelp 0
  ShowHelp 02
  return 1
  }

if {! $Crippled}  {
  catch [exec rm -rf $TempDir]
  }
if {$SavOpt}  {
  SaveConfig
  }

exit
}


#-----------------------------------------------------------------------------
#  DelArc  --  Delete a file
#-----------------------------------------------------------------------------
proc DelArc {owner}  {
global ErrArgs MenuHelp MainSelected ADWarn

if {$MenuHelp}  {
  set MenuHelp 0
  ShowHelp 05
  return 1
  }
#  Fake disabled button
if {! $MainSelected}  {
  return 1
  }

set win ".$owner"
set dirn [ GetCurDir "$owner" ]
if {[$win.list2.arclist curselection] == ""}  {
  GErrMsgBox 14;
  return -1;
  }
set arcn [$win.list2.arclist get [$win.list2.arclist curselection]]; \
if {$dirn == "/dev"}  {
  GErrMsgBox 15;
  return -1;
  }

#  Do the warning thing...
if {$ADWarn}  {
  set ErrArgs "$dirn/$arcn"
  set rc [GModMsgBox $owner 104]
  if {! $rc}  {
    return 1
    }
  }
catch [exec rm $dirn/$arcn]
set curdir [ pwd ]
#UpdDirList $owner $curdir
RefDirs $curdir

return 1
}



#-----------------------------------------------------------------------------
#  CreateArc  --  Create a new archive file
#-----------------------------------------------------------------------------
proc CreateArc {owner dirname arcname}  {
global ErrArgs MenuHelp ArcWin MainButBg MainBg WhoBg ShnHeur
global GotTar GotGtar GotGzip GotZip GotZcat GotCompress 
global GotAr GotArj GotRar GotShn GotBzip GotLha GotCpio GotRpm 

set WBg $MainBg
set WButBg $MainButBg
set EntBg "bisque"
set WFg "black"

if {$MenuHelp}  {
  set MenuHelp 0
  ShowHelp 03
  return 1
  }
set win ".$owner"

#  OK, pop up a what'll ya have dialogue...
#-------------------------------------------------------------------
#  Make some unique names for us...
incr ArcWin
set thiswin "create$ArcWin"
set WinName ".$thiswin"
set crfunc "crfunc$thiswin"
global $crfunc
set $crfunc 0

if {$dirname == "dummy" && $arcname == "dummy"}  {
  set arcname ""
  set dirname [ GetCurDir "$owner" ]
  }
set arcn "arcname$thiswin"
global $arcn
set $arcn $arcname
set expn "expname$thiswin"
global $expn
set $expn $arcname

set type 0
set atype "atype$thiswin"
global $atype
set $atype 0

if [catch {toplevel $WinName}] {
  raise $WinName
  } else {
#  Build the window...
  set arctitle "Create Archive"
  wm title $WinName $arctitle
  set topf [frame $WinName.top -bg $WBg -highlightbackground $WBg]
  set buttons [frame $topf.but -bg $WBg -highlightbackground $WBg]
  set namef [frame $WinName.top.namef -bg $WBg -highlightbackground $WBg]
  set typef [frame $WinName.top.types -bg $WBg -highlightbackground $WBg]
  set typef1 [frame $WinName.top.types.types1 -bg $WBg -highlightbackground $WBg]
  set typef2 [frame $WinName.top.types.types2 -bg $WBg -highlightbackground $WBg]
  set typef3 [frame $WinName.top.types.types3 -bg $WBg -highlightbackground $WBg]

  set cmd "CreateArc2 $thiswin"
  button $buttons.create -text "Create" -command $cmd \
    -bg $WButBg -highlightbackground $WButBg
  set cmd "KillCreate $thiswin"
  button $buttons.quit -text "Cancel" -command $cmd \
    -bg $WButBg -highlightbackground $WButBg
#  Gotta intercept wm killing the window with this command too
  wm protocol $WinName "WM_DELETE_WINDOW" $cmd
  wm protocol $WinName "WM_SAVE_YOURSELF" $cmd

  label $namef.where -text "   Directory:  " -relief flat -bg $MainBg
  entry $namef.dir -text " " -relief sunken -bg $WhoBg -width 30 \
  -font "-*-fixed-bold-*-*-*-*-*-*-*-*-*-*-1"
  label $namef.fndsc -text "   Archive Name:  " -bg $WBg -highlightbackground $WBg
  entry $namef.fname -textvariable $arcn -bg $EntBg -highlightbackground $EntBg -width 20
  label $namef.pad -text "    " -bg $WBg -highlightbackground $WBg
  radiobutton $typef1.tar -variable $atype -value 3 -text "tar" -bg $WBg -highlightbackground $WBg
  radiobutton $typef1.zip -variable $atype -value 2 -text "zip" -bg $WBg -highlightbackground $WBg
  radiobutton $typef1.tgz -variable $atype -value 1 -text "gzipped tar" -bg $WBg -highlightbackground $WBg
  radiobutton $typef1.taz -variable $atype -value 5 -text "compressed tar" -bg $WBg -highlightbackground $WBg
  radiobutton $typef1.tbz -variable $atype -value 14 -text "bzipped tar" -bg $WBg -highlightbackground $WBg

  radiobutton $typef2.gzp -variable $atype -value 4 -text "gzip" -bg $WBg -highlightbackground $WBg
  radiobutton $typef2.cmp -variable $atype -value 6 -text "compress" -bg $WBg -highlightbackground $WBg
  radiobutton $typef2.ar -variable $atype -value 9 -text "ar archive" -bg $WBg -highlightbackground $WBg
  radiobutton $typef2.bzp -variable $atype -value 13 -text "bzip" -bg $WBg -highlightbackground $WBg
#  radiobutton $typef2.arj -variable $atype -value 10 -text "arj" -bg $WBg -highlightbackground $WBg -state disabled
#  radiobutton $typef2.rar -variable $atype -value 11 -text "rar" -bg $WBg -highlightbackground $WBg -state disabled
  radiobutton $typef2.shn -variable $atype -value 12 -text "shorten" -bg $WBg -highlightbackground $WBg

  radiobutton $typef3.lha -variable $atype -value 15 -text "lharc (lzh)" -bg $WBg -highlightbackground $WBg
  radiobutton $typef3.cpio -variable $atype -value 16 -text "cpio" -bg $WBg -highlightbackground $WBg

  if {! $GotTar}  {
    $typef1.tar configure -state disabled
    $typef1.tgz configure -state disabled
    $typef1.taz configure -state disabled
    $typef1.tbz configure -state disabled
    }
  if {! $GotZip}  {
    $typef1.zip configure -state disabled
    }
  if {! $GotGzip}  {
    $typef1.tgz configure -state disabled
    $typef2.gzp configure -state disabled
    }
  if {! $GotCompress && ! $GotZcat}  {
    $typef1.taz configure -state disabled
    $typef2.cmp configure -state disabled
    }
  if {! $GotAr}  {
    $typef2.ar configure -state disabled
    }
  if {! $GotBzip}  {
    $typef1.tbz configure -state disabled
    $typef2.bzp configure -state disabled
    }
  if {! $GotShn}  {
    $typef2.shn configure -state disabled
    }
  if {! $GotLha}  {
    $typef3.lha configure -state disabled
    }
  if {! $GotCpio}  {
    $typef3.cpio configure -state disabled
    }

  pack $buttons.create $buttons.quit -side left
  pack $namef.where $namef.dir $namef.fndsc $namef.fname $namef.pad -side left -expand no
  pack $typef1.tar $typef1.zip $typef1.tgz $typef1.taz $typef1.tbz -side left 
  pack $typef2.gzp $typef2.cmp $typef2.ar $typef2.bzp $typef2.shn -side left
  pack $typef3.lha $typef3.cpio -side left
  pack $typef3 $typef2 $typef1 -side bottom


#  Now build a file selection list for directory to create in & filename...
  set flbody [ frame $WinName.body  -bg $WBg -highlightbackground $WBg]
  set body $thiswin.body

  set stuff [BuildDirList "$body"]

  pack $flbody -anchor w -fill x -side bottom -fill both -expand yes
  
  pack $typef -side bottom -fill both -expand yes
  pack $namef -side bottom -anchor center 
  pack $buttons -side bottom
  
  pack $topf -side bottom -anchor center -expand yes -fill x

  set cmd "UpdCraDir $body"
  bind $flbody.list1.dirlist <Double-1> $cmd
  set cmd "CreateSel1 $thiswin"
  bind $flbody.list2.arclist <Double-1> $cmd
  $flbody.list2.arclist configure -selectmode single

  set cradir "CraDir$body"
  global $cradir
  set $cradir $dirname

  set cmd "UpdCraDir2 $thiswin"
  bind $namef.dir <Return> $cmd

  $namef.dir configure -textvariable $cradir
  set $cradir [UpdDirList "$body" "$dirname"]

  }

return 1
}

#-----------------------------------------------------------------------------
#  CreateSel1  --  What to do if one file is double-clicked -
#      set the filename, doctored with conventional extensions...?
#-----------------------------------------------------------------------------
proc CreateSel1 {owner}  {

set alist ".$owner.body.list2.arclist"
set fname ".$owner.top.namef.fname"
set tmp  "atype$owner"
global $tmp
set type [set $tmp]
set fname "arcname$owner"
global $fname
set expn "expname$owner"
global $expn


if {! $type}  {
  return 1
  }
set fn [$alist get [$alist curselection]]
set $expn $fn
set fn [StandardName $fn $type]
set $fname $fn

return 1
}

#-----------------------------------------------------------------------------
#  StandardName  --  Make archive name adhere to standard conventions
#-----------------------------------------------------------------------------
proc StandardName {oldname type}  {
global GnuLin

switch $type      {
    1          {
        if {! $GnuLin}  {
          set ext ".tar.gz"
          set ext2 ".tgz"
          }  else  {
          set ext ".tgz"
          set ext2 ".tar.gz"
          }

        }
    2          {
        set ext ".zip"
        }
    3          {
        set ext ".tar"
        }
    4          {
        set ext ".gz"
        }
    5          {
        set ext ".tar.Z"
        }
    6          {
        set ext ".Z"
        }
    9          {
        set ext ".a"
        }
    10         {
        set ext ".arj"
        }
    11         {
        set ext ".rar"
        }
    12         {
        set ext ".shn"
        }
    13         {
        set ext ".bz"
        }
    14         {
        set ext ".tar.bz"
        }
    15         {
        set ext ".lzh"
        }
    default    {
        return $oldname
        }
    }

set newname $oldname
set l1 [string length $oldname]
set l2 [string length $ext]
set l3 [expr $l1 - $l2]
if {$l3 == -1}  {
  incr l3 -1
  }
set l4 [string last $ext $oldname]
if {$l3 != $l4}  {
  if {$type == 1}  {
    set l2 [string length $ext2]
    set l3 [expr $l1 - $l2]
    set l4 [string last $ext2 $oldname]
    if {$l3 != $l4}  {
      set newname "$oldname$ext"
      }
    }  else  {
    set newname "$oldname$ext"
    }
  }

return $newname
}

#-----------------------------------------------------------------------------
#  KillCreate  --  Kill the CreateArc window
#-----------------------------------------------------------------------------
proc KillCreate {owner}  {

set body "$owner.body"
set tmp "CraDir$body"
global $tmp
set dirname [set $tmp]
set tmp "arcname$owner"
global $tmp
set arcname [set $tmp]

PluckFromList $owner "FLList"
set WinName ".$owner"
destroy $WinName

return 1
}

#-----------------------------------------------------------------------------
#  CreateArc2  --  part 2 - name has been selected
#-----------------------------------------------------------------------------
proc CreateArc2 {owner}  {
global ErrArgs StdNames GnuLin TmpNo TempDir

set body "$owner.body"
set tmp "CraDir$body"
global $tmp
set dirname [set $tmp]
set tmp "arcname$owner"
global $tmp
set arcname [set $tmp]
set tmp "atype$owner"
global $tmp
set type [set $tmp]
set WinName ".$owner"
set expn "expname$owner"
global $expn
set expname [set $expn]
incr TmpNo
set tno $TmpNo
set lstf "$TempDir/TkzLst$tno"
set errf "$TempDir/TkzErr$tno"
set flist "$TempDir/TkzFlst$tno"



if {$arcname == "" || $type == "" || $type == 0}  {
  return -1
  }
if {$dirname == "/dev"}  {
  GErrMsgBox 15;
  return -1;
  }
#  Dammit! -- we have to check filename against programs that will
#  force a DOS-style type "extension" - even if we are not using the
#  standard names option.

if {$StdNames}  {
  set arcname [StandardName $arcname $type]
  }  else  {
  switch  $type  {
      2    {
        set ext [string length $arcname]
        incr ext -4
        if {[string range $arcname $ext end ] != ".zip"}  {
          set arcname "$arcname.zip"
          set tmp "arcname$owner"
          set $tmp $arcname
          }
        }
      10    {
        set ext [string length $arcname]
        incr ext -4
        if {[string range $arcname $ext end ] != ".arj"}  {
          set arcname "$arcname.rar"
          set tmp "arcname$owner"
          set $tmp $arcname
          }
        }
      11    {
        set ext [string length $arcname]
        incr ext -4
        if {[string range $arcname $ext end ] != ".rar"}  {
          set arcname "$arcname.rar"
          set tmp "arcname$owner"
          set $tmp $arcname
          }
        }
      13    {
        set ext [string length $arcname]
        incr ext -3
        if {[string range $arcname $ext end ] != ".bz"}  {
          set arcname "$arcname.bz"
          set tmp "arcname$owner"
          set $tmp $arcname
          }
        }
      15    {
        set ext [string length $arcname]
        incr ext -4
        if {[string range $arcname $ext end ] != ".lzh"}  {
          set arcname "$arcname.bz"
          set tmp "arcname$owner"
          set $tmp $arcname
          }
        }
      default  {
        }
      }
  }

if { [file exists $dirname/$arcname] }  {
  set ErrArgs "$dirname/$arcname"
  set action [GModMsgBox $owner 105]
  if {! $action}  {
    return -1
    }  else  {
    #  We really need to move this closer to where the action is...
    catch { [exec rm $dirname/$arcname] }
    RefDirs $dirname
    }
  }

#  Express compress...
switch  $type        {
    4      -
    6      -
    12     -
    13     {
      if {$expname != ""}  {
        if {$expname != $arcname}  {
          set ErrArgs "$expname $arcname"
          set doit [GModMsgBox $owner 106]
          if {! $doit}  {
            return -1
            }  else  {
            #  Set all the parent & owner vars needed by the compress rtns & fake it...
            set ff [open $flist w]
            puts $ff "$dirname/$expname"
            catch {[close $ff]}
            set tmp "ArcFno$owner"
            global $tmp
            set $tmp $type
            #  Call the appropriate Add routine...
            switch $type        {
                4        {
                    set rc [AddGzp $owner $owner $dirname $arcname $flist $lstf $errf]
                    }
                6        {
                    set rc [AddCmp $owner $owner $dirname $arcname $flist $lstf $errf]
                    }
                12       {
                    set rc [AddShn $owner $owner $dirname $arcname $flist $lstf $errf]
                    }
                13       {
                    set rc [AddBzip $owner $owner $dirname $arcname $flist $lstf $errf]
                    }
                }
            KillCreate $owner
            RefDirs $dirname
            DispArc $dirname $arcname 0 0
            return $rc
            }


          }  else  {
          #  No can do...
          set ErrArgs "$expname"
          GErrMsgBox $owner 83
          return -1
          }
        }

      }

    }


# Now open up a dir window on an empty archive, and let 'em use the add button

KillCreate $owner
DispArc $dirname $arcname 1 $type


return 1
}



#-----------------------------------------------------------------------------
#  MainSelect  --  What to do when main listbox gets an item selected
#-----------------------------------------------------------------------------
proc MainSelect {}  {
global MainSelected

.main.f2.but2.m1 entryconfigure 3 -state normal \
   -foreground black
.main.f2.but2.m1 entryconfigure 4 -state normal \
   -foreground black
set MainSelected 1
KillViewButtons

return 1
}



#-----------------------------------------------------------------------------
#  MainSelect1  --  What to do when main listbox gets an item selected
#-----------------------------------------------------------------------------
proc MainSelect1 {}  {

KillViewButtons

return 1
}



#-----------------------------------------------------------------------------------
#  KillViewButtons  --  obnoxious little hack to account for Tk's indefensible habit
#      of deselecting everything in all the other windows when you select anything. 
#      (In other words, it's just using the current X selection, nuttin' fancy.)
#-----------------------------------------------------------------------------------
proc KillViewButtons {}  {
global ViewButtons
set thisproc "KillViewButtons"

foreach buttons "$ViewButtons"  {
  $buttons.view configure -state disabled
  $buttons.ext configure -state disabled
  $buttons.del configure -state disabled
  }

return 1
}




#-----------------------------------------------------------------------------------
#  KillOtherButtons  --  as above, but don't mess with mine. 
#-----------------------------------------------------------------------------------
proc KillOtherButtons {MyButton}  {
global ViewButtons

foreach buttons "$ViewButtons"  {
  if {$buttons != $MyButton}  {
    $buttons.view configure -state disabled
    $buttons.ext configure -state disabled
    $buttons.del configure -state disabled
    }
  }

return 1
}


#-----------------------------------------------------------------------------------
#  KillMyButtons  --  Ok, mess with mine, big time. Called before I destroy myself. 
#-----------------------------------------------------------------------------------
proc KillMyButtons {MyButton}  {
global ViewButtons

set tmpbut ""
foreach buttons "$ViewButtons"  {
  if {$buttons != $MyButton}  {
    set tmpbut "$tmpbut $buttons"
    }
set ViewButtons $tmpbut
  }

return 1
}



#-----------------------------------------------------------------------------
#  SetupView  --  
#-----------------------------------------------------------------------------
proc SetupView {owner}  {
global ErrArgs MenuHelp MainSelected

if {$MenuHelp}  {
  set MenuHelp 0
  ShowHelp 04
  return 1
  }

if {! $MainSelected}  {
  return 1
  }

set win ".$owner"

set dirn [ GetCurDir "$owner" ]
if {[$win.list2.arclist curselection] == ""}  {
  GErrMsgBox 8;
  return -1;
  }
set arcn [$win.list2.arclist get [$win.list2.arclist curselection]]; \
DispArc $dirn $arcn 0 0;

return 1
}



#-----------------------------------------------------------------------------
#  GetCurDir  --  Returns the current directory variable for the owning window
#-----------------------------------------------------------------------------
proc GetCurDir {owner}  {
global Debug
if {$Debug}  {
#  puts "GetCurDir entered with arg $owner"
  }
set cdvar CurDir$owner
set curdir [ pwd ]
global set $cdvar
if [info exists $cdvar]  {
  if {$Debug}  {
#    puts "cdvar found - $cdvar = [set $cdvar]"
    }
  set curdir [set $cdvar]
  } else  {
  set $cdvar $curdir
  }

return $curdir
}



#---------------------------------------------------------------------- 
#  UpdDirList  --  Display the current directory in a pair of listboxes 
#---------------------------------------------------------------------- 
proc UpdDirList {WinName NewDir} {
global WhoBg MainButBg MainBg PgmName ErrArgs Debug
global TarPgm TgzLstFlags CurDir ArcOnly FTypes RTypes RawDev
global MainWhere2

#if {$Debug}  {
#  puts "UpdDirList called from $WinName for $NewDir..."
#  }

set owner ".$WinName"
set cdvar "CurDir$WinName"
global $cdvar
set where [set $cdvar]

#  If the directory is /proc, don't go there
#  If it's .TkZip..., don't go there either
#  If the dir is /dev, only show selected devices

if {$NewDir == "proc/"} {
  # Tell 'em we don't go there...
  GErrMsgBox 2
  return $where
  }

if {[string first ".TkZip" $NewDir] == 0} {
  # Aww, let 'em do  it if in debug mode...
  if {! $Debug}  {
    set ErrArgs $NewDir
    GErrMsgBox 16
    return $where
    }
  }

if {! [file exists $NewDir]} {
  # Tell 'em we don't make directories...
  set ErrArgs $NewDir
  GErrMsgBox 17
  if {$owner == ".main"}  {
    global CurDirmain
    set CurDirmain $MainWhere2
    }
  return $where
  }

catch {cd [set $cdvar]}
catch {cd $NewDir}
set where [ pwd ]
set $cdvar $where
set CurDir $where
if {$owner == ".main"}  {
  set MainWhere2 $where
  }

GetDirInfo $owner $where

return $where
}


#----------------------------------------------------------
#  PluckFromList  --  Remove a window from a global list 
#----------------------------------------------------------
proc PluckFromList {owner listname} {

global $listname
set list [set $listname]
set oloc [string first "$owner" $list]
set oend [string first " " [string range $list $oloc end]]
if {$oend == -1}  {
  set oend [string length $list]
  }  else  {
  incr oend $oloc
  }
incr oloc -1
incr oend
set pt1 [string range $list 0 $oloc]
set pt2 [string range $list $oend end]
set list [string trim "$pt1$pt2"]
set $listname $list

}


#---------------------------------------------------------
#  RefDirs  --  Refresh all active file lists 
#---------------------------------------------------------
proc RefDirs {rdir} {
global FLList
set thisproc "RefDirs"

foreach owner $FLList  {
  set tmp "CurDir$owner"
  global $tmp
  set dir [set $tmp]
  #  If this guy's dir is the one updated, or a descendant...
  if {[string first "$rdir" "$dir"] == 0}  {
    UpdDirList "$owner" "$dir"
    }
  }

}


#---------------------------------------------------------
#  GetDirInfo  --  fill in the directory & file lists 
#---------------------------------------------------------
proc GetDirInfo {owner dir} {
global ArcOnly RTypes FTypes

if {$dir == "/dev"} {
  set RawDev 1
  } else {
  set RawDev 0
  }

#  New, better way... 
$owner.list1.dirlist delete 0 end
$owner.list2.arclist delete 0 end
#  Slowly weeding out all that needless directory changing...
set flist [glob .* *]
#set flist [glob $dir/.* $dir/*]
set flist [lsort $flist]
if {$RawDev}  {
  $owner.list1.dirlist insert end "../"
  }
set stripl [string length $dir]
incr stripl
foreach file "$flist"  {
#  set file [string range $file $stripl end]
  if {$file != "."}  {
    if {[file isdirectory $file] && ! $RawDev}  {
      set file "$file/"
      $owner.list1.dirlist insert end $file
      }  else  {
      if {$RawDev}  {
#--------
        set gotit 0
        foreach f $RTypes {
            if { [string first $f $file] == 0 && ! $gotit } {
	    set gotit 1
            $owner.list2.arclist insert end $file
	    }
	  }
#--------
        }  else  {
	if {$ArcOnly}  {
#--------
          set gotit 0
	  set llen [string length $file]
          foreach f $FTypes {
	    set tlen1 [string length $f]
	    set tloc2 [expr $llen - $tlen1]
	    set typeloc [string last $f $file]
            if { $typeloc > 0 && $typeloc == $tloc2 && ! $gotit } {
	      set gotit 1
              $owner.list2.arclist insert end $file
	      }
	    }
#--------
	  }  else  {
	  $owner.list2.arclist insert end $file
	  }
	}
      }
    }
  }



return 1
}


#---------------------------------------------------------
#  BuildDirList  --  build a scrolling directory/file list
#       associated with a specific window frame
#---------------------------------------------------------
proc BuildDirList {wname} {
global WhoBg MainButBg MainBg PgmName DirWin Debug FLList

set owner $wname
set cdvar "CurDir$wname"
global $cdvar
set $cdvar ""
set FLList [string trim "$FLList $owner"]

frame .$wname.list1 -highlightbackground $MainBg -bg $MainBg
label .$wname.list1.lab1 -text "Directories" -relief flat -bg $MainBg -width 20
set cmd ".$wname.list1.dirlist yview"  
scrollbar .$wname.list1.diry -command $cmd
set cmd ".$wname.list1.dirlist xview"
scrollbar .$wname.list1.dirx -orient horizontal -command $cmd
set ycmd ".$wname.list1.diry set"
set xcmd ".$wname.list1.dirx set"
listbox .$wname.list1.dirlist -relief sunken -bg white -width 40 \
    -selectforeground white \
    -selectbackground $MainButBg \
    -yscroll $ycmd \
    -xscroll $xcmd \
    -height 15  -font "-*-fixed-bold-*-*-*-*-*-*-*-*-*-iso8859-1"
pack .$wname.list1.lab1
pack .$wname.list1.diry -side right -fill y
pack .$wname.list1.dirx -side bottom -fill x
pack .$wname.list1.dirlist -side left -fill both -expand yes


frame .$wname.list2 -highlightbackground $MainBg -bg $MainBg
label .$wname.list2.lab1 -text "Files" -relief flat -bg $MainBg -width 20
set cmd ".$wname.list2.arclist yview"  
scrollbar .$wname.list2.diry -command $cmd
set cmd ".$wname.list2.arclist xview"
scrollbar .$wname.list2.dirx -orient horizontal -command $cmd
set ycmd ".$wname.list2.diry set"
set xcmd ".$wname.list2.dirx set"
listbox .$wname.list2.arclist -relief sunken -bg white -width 40 \
    -selectforeground white \
    -selectbackground $MainButBg \
    -yscroll $ycmd \
    -xscroll $xcmd \
    -height 15  -font "-*-fixed-bold-*-*-*-*-*-*-*-*-*-iso8859-1"
pack .$wname.list2.lab1
pack .$wname.list2.diry -side right -fill y
pack .$wname.list2.dirx -side bottom -fill x
pack .$wname.list2.arclist -side left -fill both -expand yes

pack .$wname.list1 .$wname.list2 -side left -fill both -expand yes

if {$Debug}  {
  #puts "Built .$wname.list1.dirlist"
  }
return 1
}



#--------------------------------------------------------
#  ToggleArcOpt  --  toggle all-files/archive-only option
#--------------------------------------------------------
proc ToggleArcOpt {owner} {
global ArcOnly CurDir MenuHelp

if {$MenuHelp}  {
  set MenuHelp 0
  set ArcOnly [ToggleOpt "$ArcOnly"]
  ShowHelp 08
  return 1
  }

UpdDirList "$owner" "$CurDir"
}

#--------------------------------
#  ToggleOpt  --  toggle a flag
#--------------------------------
proc ToggleOpt {opt} {

if {$opt == 0} {
  set opt 1
  } else {
  set opt 0
  }
return $opt
}



#--------------------------------------------------------
#  DispArc  --  Display the Archive contents in a listbox
#
#  - To Do:  Everything.
#            Lose the attempt to create one template command line,
#            it's gotten too unwieldy.
#            - Make a separate func for each type
#              - Note that most magic files will likely NOT know about shorten or bzip
#                files, and possibly not rar or arj files (though ours does recognize 
#                the latter two). Then again, the one on my ISP's SunOS system doesn't
#                even recognize a tar. Go figure.
#
#--------------------------------------------------------
proc DispArc {dirname arcname creating crtype} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg
global CurDir ArcWin ErrArgs WinList
global ATypes VNames VBins Vnum GotPgm Debug NewRaw TempDir

set thisproc "DispArc"
if {$Debug}  {
#  puts "$thisproc  entered with args '$dirname' '$arcname'."
  }

#  First, see whether this file is already open...just raise if so.
set floc [string first "$dirname/$arcname" $WinList]
if {$floc != -1}  {
  incr floc -2
  set oloc [string wordstart $WinList $floc]
  set owner [string range $WinList $oloc $floc]
  raise .$owner
  return 1
  }

#  Make some unique names for us...
incr ArcWin
set thiswin "conts$ArcWin"
set WinName ".$thiswin"
set viewer "vnam$thiswin"
set viewbin "vbin$thiswin"
set viewnum "vnum$thiswin"
#  We're our own owner...
set owner $thiswin

# set tf "tmparc$owner"
# global $tf
# set $tf "$TempDir/TkzTArc"
set tmp "creating$thiswin"
global $tmp
set $tmp $creating
if {! $creating && ! [file exists $dirname/$arcname] }  {
  set creating 1
  }

set tmp "creating$owner"
global $tmp
set $tmp $creating
if {$creating && ! $crtype}  {
  CreateArc $owner $dirname $arcname
  return 1
  }


#  OK, now what...? Time for a new func...  It should just set the type,
#  not try to construct a "common" command line. Then we'll do a switch on the
#  type, calling the appropriate directory read routine for each type.
#  Call the new guy...
set arctype [ArcType2 "$thiswin" "$dirname" "$arcname" "$creating" "$crtype"]

if {$arctype == " "}  {
  return -1
  }
if {$arctype == "Unknown File Type"}  {
  #  Pop up err msg here...
  set ErrArgs "$arcname"
  GErrMsgBox 1
  return -1
  }

    #  Access some globals new guy set...
#-------------------------------------
    set at "ArcType$thiswin"
    global $viewer $viewbin $viewnum $at
    set $viewnum 1
    set $viewer $VNames([set $viewnum])
    set $viewbin $VBins([set $viewnum])
    set $at $arctype
#-------------------------------------


#  OK, build the directory list.

set cc [BuildArcDir2 $thiswin $arcname $dirname $creating]
if {$cc != 1}  {
  set ErrArgs "$arcname"
  GErrMsgBox 1
  return -1
  }

#  If we're in our temp dir, this was an internal call & a temp file...
set tname ""
set l1 [string last "/" $dirname]
if {$l1 != -1}  {
  incr l1 -1
  set tname [string range $dirname 0 $l1]
  }
if {$tname == $TempDir}  {
  set killist "Kill$owner"
  global $killist
  set $killist "[set $killist] $dirname/$arcname"
  }

return 1
}




#------------------------------------------------------------
#  ArcType2  --  decide what type of archive we think this is
#    - 03/29/1997 - if file doesn't exist, we came from the
#      create dialogue, use the type set there...
#------------------------------------------------------------
proc ArcType2 { owner dirname arcname creating ArcFno} {
global ArcPgm UnarcPgm ArcFlags ListFlags ExtFlags FTypes RawDev Debug
global CurDir ArcWin ErrArgs TempDir TmpNo MyPid Desperation

set thisproc "ArcType"
set thiswin $owner
set WinName ".$owner"


incr TmpNo
set tno $TmpNo
set tmpdxf "$TempDir/TkzDTmp1$tno"
set errdxf "$TempDir/TkzDErr$tno"

set tmparc "$TempDir/TkzTArc$tno"
set tmp "tmparc$thiswin"
global $tmp
set $tmp $tmparc
set tmp "sdirl$owner"
global $tmp
set $tmp ""

set temptar "TmpTar$owner"
global $temptar
set $temptar ""
set tmp "TmpBz$owner"
global $tmp
set $tmp ""
set tmp "TmpRar$owner"
global $tmp
set $tmp ""
set tmp "TmpArj$owner"
global $tmp
set $tmp ""

set RawDev 0
set cc ""
set rc 0
set fpos 1
#set creating 0
#if { ! [file exists $dirname/$arcname] }  {
#  # Have to get the type here...how?
#  set creating 1
#  }
set simple 0


if {$dirname == "/dev"}  {
  set RawDev 1
  if {$creating} {
    GErrMsgBox 15
    return " "
    }
  }

if { ! $creating }  {
#--------------------------------------------==================================================
if {$RawDev} {
    #    - if it's a device, copy a bit of the file from the the raw dev to a temp file
    if { [string first "n" $arcname] == 0 }  {
      set TheFile $tmparc
      #  If it's a non-rewinding tape, go ahead and copy the whole thing now...
      #  Caveat emptor, it needs major testing and, probably, cleanup.
#  
#  Insert Non-Rewinding tape positioning logic here...
#-----------------------------------------------------------------
      set fpos 0
      set prc [catch { set dummy [exec mt -f $dirname/$arcname status]} cc]
      set fp [string first "file number =" $cc]
      #  If there's an mt that speaks our dialect, ask the user which
      #  file, and try to position the tape.
      #  This test will bear some refinement...
      if {$fp != -1}  {
        incr fp 13
        set fpos [lindex [string range $cc $fp end] 0]
        #  Now call new func to set pos...
        set fpos [GetTapePos1 $owner $arcname $dirname]
        }
#-----------------------------------------------------------------
      if {$fpos}  {
        catch [exec cat $dirname/$arcname >$tmparc]
        catch [ exec mt -f $dirname/$arcname bsf 1]
        }  else  {
        return " "
        }
      }  else  {
      #  OK, floppy or rewinding tape, get a few bytes...
      set TheFile "$dirname/$arcname"
      catch [exec dd if=$dirname/$arcname of=$tmparc ibs=4096 count=1]
#      catch [exec cat $dirname/$arcname >$tmparc]
      }
    if {$fpos}  {
      set rc [catch {set dummy [exec file $tmparc ]} cc]
      }
  }  else  {
  #  Try to identify the real file...
  set TheFile "$dirname/$arcname"
  set rc [catch {set dummy [exec file $dirname/$arcname ]} cc]
  }

set fno 0

#  catch {puts "\n================\nfile probe response:\n    $cc\n================\n"}
  if { $cc == "$dirname/$arcname: archive" }  {
    set fno 9
    }
  if {$fno == 0}  {
    if { [string first "ARJ" $cc] != -1 }  {
      set fno 10
      }
    }
  if {$fno == 0}  {
    if { [string first "RAR" $cc] != -1 }  {
      set fno 11
      }
    }
  if {$fno == 0}  {
    if { [string first " Zip " $cc] != -1 || [string first "ip archive" $cc] != -1}  {
      set fno 2
      }
    }
  if {$fno == 0}  {
    if { [string first " tar " $cc] != -1 }  {
      set fno 3
      }
    }
  if {$fno == 0}  {
    if { [string first " gzip " $cc] != -1 }  {
      set fno 4
      set simple 1
      }
    }
  if {$fno == 0}  {
    #  Bzips have "BZ" at position 0...need more detail
    if { [string first "bzip" $cc] != -1 }  {
      set fno 13
      set simple 1
      }
    }
  if {$fno == 0}  {
    #  Shorten magic string is "ajkg" at position 1...
    #  (or sometimes at 0...?)
    if { [string first " shorten " $cc] != -1 }  {
      set fno 12
      set simple 1
      }
    }
  if {$fno == 0}  {
    #  This depends on the fact that we've already screened out gzips and bzips...
    if { [string first " compress" $cc] != -1 }  {
      set fno 6
      set simple 1
      }
    }
  if {$fno == 0}  {
    if { [string first " executable " $cc] != -1 }  {
      set fno 7
      }
    }
  if {$fno == 0}  {
    if { [string first "LHa" $cc] != -1 }  {
      set fno 15
      }
    }
  if {$fno == 0}  {
    if { [string first " cpio " $cc] != -1 }  {
      set fno 16
      }
    }


#  Special hack for those pgms that don't like to read devices...
#  copy the damned thing to a temp disk file if it's not tar, gzip, or compress.
if {$RawDev && $fno != 0}  {
  if { [string first "n" $arcname] != 0 }  {
    if {$fno != 3 && $fno != 4 && $fno != 6}  {
      catch [exec cat $dirname/$arcname >$tmparc]
      }
    }
  }


#  The problem here is that it's not all that uncommon to find a "portably challenged" system
#  on which the file command doesn't recognize a plain tar - so, if Desperation mode is set,
#  we will have to do the brute force thing if we haven't identified the file yet...
#
#  Note - on my system, a multipart zip that has been artificially "sewn back together"
#  by concatenating the parts wasn't recognized by file, even though unzip would handle it.
#  Had to tweak magic - the files start with a string of PK\007\010PK - rather than make 
#  another "Desperation" hack...
#
if {$fpos && $fno == 0 && $Desperation}  {
  #  Kluge time...
  set trc [catch {set dummy [exec tar -tvf $TheFile ]} cc]
  if {$rc == 0 && $cc != "" && [string first "oesn't" $cc] < 0 && [string first "kipping to" $cc] < 0 && [string first "nly read" $cc] < 0 && [string first "unknown file" $cc] < 0 }  {
    set fno 3
    }
  }

set ArcFno $fno
#--------------------------------------------==================================================
  }



set arctype [SetArcVars $owner $ArcFno]

set fv "ArcFno$owner"
global $fv
set $fv $ArcFno
#  Gotta rmember to change this if we find a complex arc...
set tmp "SimpleCmp$owner"
global $tmp
set $tmp $simple

#  Gotta add logic to set this...
set rdv "RawDev$owner"
global $rdv
set $rdv $RawDev


return $arctype
}


#------------------------------------------------------------
#  GetTapePos1  --  Find out what file the user wants from
#                   a non-rewinding tape...
#                   -----------------------------------------
#                   Gotta work up some nicer looking widgets,
#                   but the code works.
#------------------------------------------------------------
proc GetTapePos1 {owner arcname dirname}  {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg
global TargFile MaxTapeFiles TapeSelected

set thiswin ".tapeno$owner"
set WBg $MainBg
set WButBg $MainButBg
set TargFile 1
set MaxTapeFiles 99
set TapeSelected 0

#----------------------------------------
if [catch {toplevel $thiswin}] {
  raise $thiswin
  } else {
  set arctitle "Select File No. for:  $dirname/$arcname"
  wm title $thiswin $arctitle
  set topf [frame $thiswin.top -bg $WBg -highlightbackground $WBg]
  set buttons [frame $topf.but -bg $WBg]

  set cmd "destroy $thiswin"
  button $buttons.quit -text "Cancel" -command $cmd \
    -bg $WButBg -highlightbackground $WButBg
  set cmd "SelectTape $thiswin"
  button $buttons.ok -text "OK" -command $cmd \
    -bg $WButBg -highlightbackground $WButBg
  set tapef [frame $topf.tf -bg $WBg]
  label $tapef.fnotag -bg $WBg -text "    Select file number to extract from $dirname/$arcname:      "
  label $tapef.fno -bg bisque -relief sunken -width 3 -height 1 -textvariable TargFile \
    -font "-*-*-bold-r-*-*-*-160-*-*-*-*-iso8859-1"  
  label $tapef.pad1 -width 2 -bg $WBg
  set tfbuttons [frame $tapef.ud -bg $WBg]

  set cmd "IncrTapePos"
  button $tfbuttons.up -text "+" -command $cmd \
    -bg $WButBg -highlightbackground $WBg \
    -relief groove -bd 3
  set cmd "DecrTapePos"
  button $tfbuttons.down -text "-" -command $cmd \
    -bg $WButBg -highlightbackground $WBg \
    -relief groove -bd 3

  label $tapef.pad2 -width 2 -bg $WBg
  set tfbpad [frame $topf.padb]
  label $tfbpad.pad1 -height 1 -bg $WBg

  pack $buttons.quit $buttons.ok -side left -anchor w -expand no 
  pack $buttons -side top -anchor n
  pack $tfbpad.pad1 -fill x -expand yes
  pack $tfbpad -side bottom -anchor w -fill x

  pack $tfbuttons.up -side top
  pack $tfbuttons.down -side bottom
  pack $tapef.fnotag $tapef.fno $tapef.pad1 $tfbuttons $tapef.pad2 -side left -anchor w -expand no
#  pack $tapef.pad2 -side left -anchor w -expand no
  pack $tapef -side bottom
  pack $topf -anchor w -fill x

  tkwait window $thiswin
  }
#----------------------------------------

if {! $TapeSelected}  {
  return 0
  }

set curfile 1
set count [expr $TargFile - $curfile]
catch [ exec mt -f $dirname/$arcname rewind]

if {$count > 0}  {
  #  Linux mt has no problem with fsf 0 - can't say for some others...
  catch [ exec mt -f $dirname/$arcname fsf $count]
  }

return $TargFile
}


#-----------------------------------------------------------
#  IncrTapePos  --  Increment the tape file position
#
#-----------------------------------------------------------
proc IncrTapePos {}  {
global TargFile MaxTapeFiles

if {$TargFile < $MaxTapeFiles}  {
  incr TargFile
  }
return 1
}


#-----------------------------------------------------------
#  DecrTapePos  --  Decrement the tape file position
#
#-----------------------------------------------------------
proc DecrTapePos {}  {
global TargFile MaxTapeFiles

if {$TargFile > 1}  {
  incr TargFile -1
  }
return 1
}


#-----------------------------------------------------------
#  SelectTape  --  Indicate tape file position is selected
#
#-----------------------------------------------------------
proc SelectTape {owner}  {
global TapeSelected

set TapeSelected 1
destroy $owner
return 1
}






#-----------------------------------------------------------
#  BuildArcDir2  --  Read the archive directory list into a
#                  listbox
#-----------------------------------------------------------
proc BuildArcDir2 {owner arcname dirname creating}  {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg
global CurDir ArcWin ErrArgs TempDir TmpNo MyPid Home
global VNames VBins VNum GotPgm Debug IgnITG
global ViewButtons WinList DseFlag

set thisproc "BuildArcDir2"

set thiswin $owner
set WinName ".$owner"

set killist "Kill$owner"
global $killist
set $killist ""
incr TmpNo
set tno $TmpNo
set tmpf "$TempDir/TkzTmp$tno"
set errf "$TempDir/TkzErr$tno"
set $killist "[set $killist] $tmpf $errf"
set at "ArcType$owner"
set fv "ArcFno$owner"
set ap "ArcPgm$thiswin"
set lf "ListFlags$thiswin"
set gp "GotPgm$thiswin"
set rdv "RawDev$owner"
global $at $fv $ap $lf $gp $rdv
set arctype [set $at]
set ArcFno [set $fv]
set arcpgm [set $ap]
set listflags [set $lf]
set gotpgm [set $gp]
set RawDev [set $rdv]
set tmp "TmpTar$owner"
global $tmp
set $tmp ""

set vdp "VDPending$owner"
global $vdp
set $vdp 0
set tmp "creating$owner"
global $tmp
set creating [set $tmp]

if {! $gotpgm}  {
# Don't just say oops, tell 'em what pgm is missing...
  # "zcat" really means we couldn't find either...
  if {$arcpgm == "zcat"}  {
    set ErrArgs "zcat/uncompress"
    }  else  {
    set ErrArgs $arcpgm
    }
  GErrMsgBox 3
  return 1
  }


    set WBg [lindex $TBg $ArcFno]
    set WButBg [lindex $TButBg $ArcFno]
    set WFg [lindex $TFg $ArcFno]
    set viewer "vnam$thiswin"
    set viewbin "vbin$thiswin"
    set viewnum "vnum$thiswin"
    global $viewer $viewbin $viewnum
    set $viewnum 1
    set $viewer $VNames([set $viewnum])
    set $viewbin $VBins([set $viewnum])

set partial 0


#  Check whether all those old vars are needed...
#  Now get down to doing it the new way...
#    so do it right this time.

    if [catch {toplevel $WinName}] {
	raise $WinName
        } else {
#  Common part, just like the old stuff...
#
        set arctitle "$arctype:  $arcname"
        if {$creating}  {
          set arctitle "* New File *  $arctitle"
          }
	wm title $WinName $arctitle
	set topf [frame $WinName.top -bg $WBg -highlightbackground $WBg]
	set buttons [frame $topf.but]
	$buttons configure -bg $WButBg
	set ViewButtons "$ViewButtons $buttons"
	set WinList [string trim "$WinList $owner-$dirname/$arcname"]
	set vopts [frame $topf.vopt]
	set arcbody [frame $WinName.body]
#	set archdr [frame $topf.hdr]
        set archdr [frame $WinName.hdr] 
	set cmd "KillArc $thiswin"
	button $buttons.quit -text "Close" -command $cmd \
	  -bg $WButBg -highlightbackground $WButBg
      #  Gotta intercept wm killing the window with this command too
        wm protocol $WinName "WM_DELETE_WINDOW" $cmd
        wm protocol $WinName "WM_SAVE_YOURSELF" $cmd

	#
	set cmd "SelectAll $thiswin $arcname $dirname"
	button $buttons.selall -text "Select All  " -width 12 -command $cmd \
	  -bg $WButBg -highlightbackground $WButBg
	set cmd "ViewItem $thiswin $arcname $dirname"
	button $buttons.view -text "View" -command $cmd \
	  -bg $WButBg -highlightbackground $WButBg -state disabled
	set cmd "ExtractItems $thiswin $arcname $dirname"
	button $buttons.ext -text "Extract" -command $cmd \
	  -bg $WButBg -highlightbackground $WButBg -state disabled
	#  Placeholders...
	set cmd "AddItem $thiswin $arcname $dirname"
	button $buttons.add -text "Add" -bg $WButBg -highlightbackground $WButBg -command $cmd -state normal
	set cmd "DelItem $thiswin $arcname $dirname"
	button $buttons.del -text "Delete" -bg $WButBg -highlightbackground $WButBg -command $cmd -state disabled
	set cmd "SetViewer $thiswin $arcname $dirname 1"
        menubutton $buttons.selv -text "Select Viewer" -bg $WButBg -highlightbackground $WButBg \
	  -menu $buttons.selv.m -relief groove -bd 3 -pady 6
	menu $buttons.selv.m -bg $WButBg -tearoff yes

	set cmd "SetViewer $thiswin $arcname $dirname"
	set vi 1
        while {$vi <= $VNum}  {
	  set vn $VNames($vi)
	  $buttons.selv.m add radiobutton -label "$vn" -command "$cmd $vi" -indicatoron 0
	  incr vi
          }

	pack $buttons.quit $buttons.selall $buttons.view $buttons.ext $buttons.add $buttons.del -side left \
	  -anchor center -fill both -expand yes
	pack $buttons.selv -anchor center -fill both -expand no
	pack $buttons -side top -anchor n -fill both -expand yes -pady 20

        $buttons.view configure -state disabled

        bind $buttons.quit <3> {ShowHelp 20}
        bind $buttons.selall <3> {ShowHelp 21}
        bind $buttons.view <3> {ShowHelp 22}
        bind $buttons.ext <3> {ShowHelp 23}
        bind $buttons.add <3> {ShowHelp 24}
        bind $buttons.del <3> {ShowHelp 25}
        bind $buttons.selv <3> {ShowHelp 26}
        set cmd "SetViewerDelete $thiswin"
        bind $buttons.selv.m <3> $cmd

	label $vopts.vndsc -text "   Viewer:  " -bg $WBg -highlightbackground $WBg -fg $WFg 
	entry $vopts.vname -textvariable $viewer -bg $WButBg -highlightbackground $WButBg -width 20
	label $vopts.vbdsc -text "   Executable:  " -bg $WBg -highlightbackground $WBg -fg $WFg
	entry $vopts.vbin -textvar $viewbin -bg $WButBg -highlightbackground $WButBg -width 20 -relief sunken
        set cmd "AddViewer $thiswin $arcname $dirname"
	bind $vopts.vbin <Key-Return> $cmd
	label $vopts.stat -text "          " -bg $WBg -highlightbackground $WBg -fg red

	pack $vopts.vndsc $vopts.vname $vopts.vbdsc $vopts.vbin $vopts.stat -side left -anchor center -fill both -expand no
	$vopts configure -bg $WBg -highlightbackground $WBg
	$vopts.vname configure -state disabled
	$vopts.vbin configure -state disabled 
	pack $vopts -anchor center -fill both -expand no -pady 8

#  Now display the archive contents in a listbox
        scrollbar $arcbody.scrolly -command "$arcbody.alist yview"
        pack $arcbody.scrolly -side right -fill y
        listbox $arcbody.alist -relief sunken -bg white -width 80 \
           -selectbackground $WBg \
           -selectforeground $WFg \
	   -yscroll "$arcbody.scrolly set" \
	   -selectmode extended \
	   -height 15  -font "-*-fixed-bold-*-*-*-*-*-*-*-*-*-iso8859-1"
	set cmd "$buttons.view configure -state normal"
	set cmd "SelectOne $thiswin"
	bind $arcbody.alist <1> $cmd

        if {$creating}  {
          $buttons.selall configure -state disabled
          $buttons.view configure -state disabled
          $buttons.ext configure -state disabled
          $buttons.add configure -state normal
          $buttons.selv configure -state disabled
          }  else  {
          set tmp "SimpleCmp$owner"
          global $tmp
          set simple [set $tmp]
          if {$simple || $ArcFno == 10 || $ArcFno == 11}  {
            $buttons.add configure -state disabled
            }
          }

	# Set up headings and data lines...this is where we depart from the old logic.
        set rc  [GetArcDir $owner $dirname $arcname $errf]
        if {$rc < 0}  {
          #  'cause switch syntax gets its knickers in a twist if you have a
          #  negative number. Grrr...
          set fakerc $rc
          set fakerc [expr 0 - $rc]
          #  Say something...
          #  puts "$thisproc:  Ah-merde! GetArcDir failed with rc = $rc    fakerc = $fakerc."

          switch  $fakerc      {
            1      -
            3      {
                #  Open error (-1) ...?
                #  Bad data (-3) ...?  (Zip does this.)
	        KillArc $thiswin
	        return -1
                }
            2      -
            4      {
                #  No data (-2) ...?  (Zip does this.)
                #  Premature eof (-4) ...?  Tell 'em and display what we've got.
                set partial 1
                }
            default    {
                #  Just say we don't recognize it.
                return -1
                }
            }
          }
	pack $topf -anchor w -fill x
	pack $archdr -anchor w -fill x
	pack $arcbody -anchor w -side bottom -fill both -expand yes
	set cmd "ViewItem $thiswin $arcname $dirname"
	bind $arcbody.alist <Double-1> $cmd

#  End of common part

        }

if {$partial}  {
#  Premature eof, but we may have some data. The user may be able to extract something 
#  useful, even though the file is corrupted.
#  Wait for the dir window to appear, then pop up error message on top of it.
  update idletasks
  set ErrArgs "$arcname $errf"
  incr TmpNo
  set tno $TmpNo
  if {!$DseFlag}  {
    catch [exec cp $errf $Home/TkzErr$MyPid-$tno]
    }
  if {$IgnITG}  {
    set dummy ""
    catch {set dummy [exec cat $errf]}
    if {[string first "trailing garbage" $dummy] != -1}  {
      return 1
      }
    }
  GErrMsgBox 12
  }

#  End of the new arc dir builder

return 1
}




#--------------------------------------------------------
#  GetArcDir  --  Get the Archive Directory list data
#
#--------------------------------------------------------
proc GetArcDir {owner dirname arcname errf} {

set thisproc "GetArcDir"
set thiswin $owner
set WinName ".$owner"
set fv "ArcFno$thiswin"
global $fv
set ArcFno [set $fv]

set rc 1

set tmp "creating$owner"
global $tmp
set creating [set $tmp]
#  If it's brand new, fake an empty directory...
if {$creating}  {
  return 1
  }


switch  $ArcFno  {
  2         -
  7         {
    set rc [GetDirZip $owner $dirname $arcname "dummy" $errf]
    }
  3         {
    set rc [GetDirTar $owner $dirname $arcname "dummy" $errf]
    }
  4         {
    set rc [GetDirGzp $owner $dirname $arcname "dummy" $errf]
    }
  6         {
    set rc [GetDirCmp $owner $dirname $arcname "dummy" $errf]
    }
  9         {
    set rc [GetDirAr $owner $dirname $arcname "dummy" $errf]
    }
  10         {
    set rc [GetDirArj $owner $dirname $arcname "dummy" $errf]
    }
  11         {
    set rc [GetDirRar $owner $dirname $arcname "dummy" $errf]
    }
  12         {
    set rc [GetDirShn $owner $dirname $arcname "dummy" $errf]
    }
  13         {
    set rc [GetDirBzip $owner $dirname $arcname "dummy" $errf]
    }
  15         {
    set rc [GetDirLha $owner $dirname $arcname "dummy" $errf]
    }
  16         {
    set rc [GetDirCpio $owner $dirname $arcname "dummy" $errf]
    }
  default         {
    set rc 0
    }

  }

return $rc
}



#--------------------------------------------------------------
#  The Ar Handling Routines --  Handle AR archive/library files
#
#--------------------------------------------------------------

#--------------------------------------------------------------
#  GetDirAr  --  Get the Archive Directory list data for an AR
#
#--------------------------------------------------------------
proc GetDirAr {owner dirname arcname dummyname errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir

set thisproc "GetDirAr"
set thiswin $owner
set WinName ".$owner"
set topf "$WinName.top"
set archdr "$WinName.hdr"
set arcbody "$WinName.body"
set fv "ArcFno$thiswin"
global $fv
set ArcFno [set $fv]
set WButBg [lindex $TButBg $ArcFno]
# incr TmpNo
set tno $TmpNo
set tmpf "$TempDir/TkzTmp$tno"
# set errf "$TempDir/TkzErr$tno"

set ap "ArcPgm$thiswin"
set lf "ListFlags$thiswin"
global $ap $lf
set arcpgm [set $ap]
set listflags [set $lf]

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" }  {
#  set tmp [string last "/" $tmparc]
#  incr tmp
#  set TheArcFile [string range $tmparc $tmp end]
  set TheArcFile $tmparc
  }


# set arcpgm "ar"
# set listflags "-t"

#  AR listing is a no-brainer...no heading, no info but member names
#  set hdrflds 1
label $archdr.h1 -relief groove
pack $archdr.h1 -anchor w -side left -fill x -expand yes
$archdr.h1 configure -bg $WButBg -highlightbackground $WButBg -text "           Name        "
# Now read the list...
	set rc [ catch { set in [ open [ concat "|$arcpgm $listflags $TheArcFile 2>$errf" ] r ] } cc]
	if {$rc != 0}  {
          #  The caller needs to take the appropriate action here...
          #  just tell him nfg...
	  return -1
	  }

	set lineno 0
        while  { [ gets $in line ] > -1 } {
	  incr lineno
          $arcbody.alist insert end $line
          }
        catch { close $in }
#  I think this should be about it for the data....
#  Now, what about error checking and window size configure...?
#  Well, only Zip needs some special checking at this point.

#  Window size - don't need xscrollbar...
        $arcbody.alist configure -width 80
#  Do we want to do this here...?
        pack $arcbody.alist  -side left -fill both -expand yes



return 1
}

#--------------------------------------------------------------
#  GetVAr  --  Get a member to view from an AR
#
#--------------------------------------------------------------
proc GetVAr {owner dirname arcname flist tmpd errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir
set thisproc "GetVAr"

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" }  {
#  set tmp [string last "/" $tmparc]
#  incr tmp
#  set TheArcFile [string range $tmparc $tmp end]
  set TheArcFile $tmparc
  }

#  Can't extract to stdout or to a specific name - put in tmp dir & copy...
#set where [pwd]
#cd $TempDir
#set rc [catch {exec ar -x $TheArcFile $fname >$errf 2>$errf} cc]
#cd $where
#catch [exec cp $TempDir/$fname $tmpf]
#catch [exec rm $TempDir/$fname]
set errc 0
set where [pwd]
set xlist ""
if [ catch {set fl [open $flist r]} ]  {
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

cd $tmpd
foreach fn $xlist  {
    set tmpf "$tmpd/$fn"
    set rc [catch {exec ar -x $TheArcFile $fn >$errf 2>>$errf} cc]
#    catch [exec cp $fn $tmpf]
#    set l1 [string first "/" $fn]
#    if {$l1 != -1}  {
#      incr l1 -1
#      set fdir [string range $fn 0 $l1]
#      catch [exec rm -rf $fdir]
#      }  else  {
#      catch [exec rm -f $fn]
#      }
  if {$rc != 0}  {
    cd $where
    return $rc
    }
  }
  cd $where



return $rc
}


#--------------------------------------------------------------
#  ExtAr  --  Extract member(s) from an AR
#
#--------------------------------------------------------------
proc ExtAr {owner dirname arcname whereto fname flist lstf errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir
set thisproc "ExtAr"
set statw ".$owner.top.vopt.stat"
set stat "Stat$owner"
global $stat
set $stat "          "
$statw configure -textvariable $stat -fg red

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" }  {
#  set tmp [string last "/" $tmparc]
#  incr tmp
#  set TheArcFile [string range $tmparc $tmp end]
  set TheArcFile $tmparc
  }


#  Pay no attention to fname, we may have a lotta files to extract...
#  gotta access the list of member names to extract.
#  Build list to pass on command line, and do that,,,

set $stat "Extracting"
$statw configure -fg red
update idletasks
set xlist ""
if [ catch {set fl [open $flist r]} ]  {
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

set where [pwd]
cd $whereto
foreach fn $xlist  {
  set rc [catch {exec ar -x $TheArcFile $fn >$lstf 2>$errf} cc]
  }

$statw configure -fg black
set $stat "   Done   "
catch { [exec rm $lstf $errf $flist] }

cd $where
return $rc
}

#--------------------------------------------------------------
#  AddAr  --  "Add" member(s) to an ar archive
#
#    Options supported:
#        None at present...  
#--------------------------------------------------------------
proc AddAr {parent owner dirname arcname flist lstf errf} {
set thisproc "AddAr"
global ErrArgs


set tmp "creating$parent"
global $tmp
set creating [set $tmp]
set tmp "apn$owner"
global $tmp
set apn [set $tmp]
#set tmp "recurs$owner"
#global $tmp
#set recurs [set $tmp]
set tmp "ArcFno$parent"
global $tmp
set type [set $tmp]
set rc 0
set TheArcFile $dirname/$arcname
set xlist ""

if [ catch {set fl [open $flist r]} ]  {
#  puts "$thisproc:    open failure"
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

set flags ""
foreach fn $xlist  {
#    ****  gotta check what the options are...
    set rc [catch {exec ar -r $TheArcFile $fn >$lstf 2>$errf} cc]
#  puts "$thisproc:  got rc = $rc compressing $fn as $TheArcFile"
#  puts "$thisproc:      cc = $cc\n"
  if {$rc != 0}  {
    break
    }
  }
#  Temp...put up a message box here...
if {$rc != 0}  {
#  puts "Error adding $fn  $TheArcFile!"
  set ErrArgs "$lstf $errf $TheArcFile"
  GErrMsgBox 88
  return $rc
  }

return $rc
}

#--------------------------------------------------------------
#  DelAr  --  Delete member(s) from an AR Archive
#
#--------------------------------------------------------------
proc DelAr {owner dirname arcname flist lstf errf} {
set thisproc "DelAr"
global ErrArgs

set TheArcFile $dirname/$arcname
set xlist ""
if [ catch {set fl [open $flist r]} ]  {
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

foreach fn $xlist  {
  set rc [catch {exec ar -d $TheArcFile $fn >$lstf 2>$errf} cc]
#  puts "$thisproc:  got rc = $rc deleting $fn"
  if {$rc != 0}  {
    break
    }
  }

if {$rc != 0}  {
  set ErrArgs "$lstf $errf $TheArcFile"
  GErrMsgBox 87
  return $rc
  }

return $rc
}



#--------------------------------------------------------------
#  The Arj Handling Routines --  Handle ARJ archive files
#
#--------------------------------------------------------------

#---------------------------------------------------------------
#  GetDirArj  --  Get the Archive Directory list data for an ARJ
#
#---------------------------------------------------------------
proc GetDirArj {owner dirname arcname dummyname errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir

set thisproc "GetDirArj"
set thiswin $owner
set WinName ".$owner"
set topf "$WinName.top"
set archdr "$WinName.hdr"
set arcbody "$WinName.body"
set fv "ArcFno$thiswin"
global $fv
set ArcFno [set $fv]
set WButBg [lindex $TButBg $ArcFno]
# incr TmpNo
set tno $TmpNo
set tmpf "$TempDir/TkzTmp$tno"
# set errf "$TempDir/TkzErr$tno"

#  Grumble! unarj insists on a ".arj" extension...the DOS legacy lives on...and on...
set temparj "TmpArj$owner"
global $temparj
set temparjfile "$TempDir/Tarj$tno.arj"
set $temparj $temparjfile

set ap "ArcPgm$thiswin"
set lf "ListFlags$thiswin"
global $ap $lf
set arcpgm [set $ap]
set listflags [set $lf]

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" }  {
#  set tmp [string last "/" $tmparc]
#  incr tmp
#  set TheArcFile [string range $tmparc $tmp end]
  set TheArcFile $tmparc
  }


# set arcpgm "unarj"
# set listflags "-l"

# Now read the list...
#	set rc [ catch { set in [ open [ concat "|$arcpgm $listflags $dirname/$arcname 2>$errf" ] r ] } cc]
        #  So if it doesn't end in .arj, make it so, or unarj will bitch.
        set tmp [string length $arcname]
        incr tmp -4
        set tmp2 [string last ".arj" $arcname]
        if {$tmp != $tmp2}  {
          set rc [ catch { exec cp $TheArcFile $temparjfile } cc ]
          set rc [ catch { set in [ open [ concat "|unarj l $temparjfile 2>$errf" ] r ] } cc]
          }  else  {
          set rc [ catch { set in [ open [ concat "|unarj l $TheArcFile 2>$errf" ] r ] } cc]
          }
	if {$rc != 0}  {
          #  The caller needs to take the appropriate action here...
          #  just tell him nfg...
	  return -1
	  }

        set dfltwidth 80
        set hdrwidth 0
        set hdrflds 7
        set llen 0
        set ll1 0
	set lineno 0
	set ignline 1
	set startdata 0

        while  { [ gets $in line ] > -1 } {
          set ll1 [expr [string length $line] ]
	  #  Customize the column headings for the archive type from listing data in this loop...
	  incr lineno
	  if { [string first "Filename" $line] == 0 }  {
	    #  Dammit, we have to doctor one of the column headings...
	    set bldash [expr [string first "modified" $line] ]
	    incr bldash -2
	    set templ1 [string range $line 0 $bldash]
	    incr bldash 2
	    set templ1 "$templ1-[string range $line $bldash end]"
	    set line $templ1
	    set hf1 1
	    set hf1a 0
	    while {$hf1a < $hdrflds}  {
	      set fname "$archdr.h$hf1"
	      label $fname -relief groove
	      $fname configure -bg $WButBg -highlightbackground $WButBg -text [ lindex $line $hf1a ]
              incr hf1
              incr hf1a
	      }
	    pack $archdr.h1 $archdr.h2 $archdr.h3 $archdr.h4 $archdr.h5 $archdr.h6 -side left  
	    pack $archdr.h7 -anchor w -side left -fill x -expand yes

            }
          if { [string first "--------" $line] == 0 }  {
            #  Adjust the column heading widths, and stop or resume ignoring data...
            if {$ignline}  {
              set startdata 1
              set hf1 1
              set hf1a 0
              while {$hf1a < $hdrflds}  {
                set fname "$archdr.h$hf1"
                set flen [expr [string length [lindex $line $hf1a] ] ]
                #  Heavy-handed kluge - oughta go to fixed font, but they're so dammned ugly!
                if {$hf1 == 1 || $hf1 == 4 || $hf1 == 6}  {
                  incr flen
                  }
                if {$hf1 == $hdrflds}  {
                  incr flen 4
                  }
	        $fname configure -width $flen
                incr hf1
                incr hf1a
                incr hdrwidth $flen
                }
              }  else  {
              set ignline 1
              set startdata 0
              }
            }
          if {! $ignline}  {	  
            $arcbody.alist insert end $line
            #  Keep track of widest line...
            if { $ll1 > $llen } {
              set llen $ll1
              }
            }
           if { $startdata }  {
             set ignline 0
             }
          }
        catch { close $in }
#  I think this should be about it for the data....
#  Now, what about error checking and window size configure...?
#  Well, only Zip needs some special checking at this point.

#  Window size - may need xscrollbar...
        if {$hdrwidth > $dfltwidth}  {
          set dfltwidth $hdrwidth
          }
	if { $llen > $dfltwidth } {
	  set ll1 $llen
	  set llen $dfltwidth
          scrollbar $arcbody.scrollx -orient horizontal -command "$arcbody.alist xview"
          $arcbody.alist configure -xscroll "$arcbody.scrollx set"
	  }

        $arcbody.alist configure -width $llen
        if { $ll1 > $llen } {
	  pack $arcbody.scrollx -fill x -side bottom
	  } 
#  Do we want to do this here...?
        pack $arcbody.alist  -side left -fill both -expand yes



return 1
}

#--------------------------------------------------------------
#  GetVArj  --  Get a member to view from an ARJ
#
#--------------------------------------------------------------
proc GetVArj {owner dirname arcname flist tmpd errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir
set thisproc "GetVArj"

set temparj "TmpArj$owner"
global $temparj
set temparjfile [set $temparj]

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" }  {
#  set tmp [string last "/" $tmparc]
#  incr tmp
#  set TheArcFile [string range $tmparc $tmp end]
  set TheArcFile $tmparc
  }

#  Make sure unarj will like the filename...
set tmp [string length $arcname]
incr tmp -4
set tmp2 [string last ".arj" $arcname]
if {$tmp != $tmp2}  {
  set TheFile $temparjfile
  }  else  {
  set TheFile $TheArcFile
  }

set errc 0
set where [pwd]
set xlist ""
if [ catch {set fl [open $flist r]} ]  {
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

# unarj extracts all, no selective extract or redirect - gotta extract all to
# a new temp dir, copy selected file, and delete all the junk. Ug-lee!
set where [pwd]
incr TmpNo
set tmpno $TmpNo
set VTempDir "$tmpd/VArj$tmpno"
cd $tmpd
catch [exec mkdir $VTempDir]
cd $VTempDir
set rc [catch {exec unarj x $TheFile >$errf 2>$errf} cc]

cd $tmpd
foreach fn $xlist  {
  if { ! [file exists $VTempDir/$fn] }  {
    set nfname [string tolower $fn]
    catch [exec cp $VTempDir/$nfname $VTempDir/$fn]
    }
  catch [exec cp $VTempDir/$fn $fn]
  }

catch [exec rm -rf $VTempDir]

return $rc
}

#-----------------------------------------------------------------
#  ExtArj  --  Extract member(s) from an ARJ
#     -- I don't know whether arj will store directory entries --
#        for now, we don't support extracting such entries if they
#        do exist.
#-----------------------------------------------------------------
proc ExtArj {owner dirname arcname whereto fname flist lstf errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir
set thisproc "ExtArj"
set statw ".$owner.top.vopt.stat"
set stat "Stat$owner"
global $stat
set $stat "          "
$statw configure -textvariable $stat -fg red

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" }  {
#  set tmp [string last "/" $tmparc]
#  incr tmp
#  set TheArcFile [string range $tmparc $tmp end]
  set TheArcFile $tmparc
  }

set temparj "TmpArj$owner"
global $temparj
set temparjfile [set $temparj]

#  Make sure unarj will like the filename...
set tmp [string length $arcname]
incr tmp -4
set tmp2 [string last ".arj" $arcname]
if {$tmp != $tmp2}  {
  set TheFile $temparjfile
  }  else  {
  set TheFile $TheArcFile
  }


#  Pay no attention to fname, we may have a lotta files to extract...
#  gotta access the list of member names to extract.
#  Extract to temp dir, then for each item in list file, copy to target,,,

set $stat "Extracting"
$statw configure -fg red
update idletasks
set xlist ""
if [ catch {set fl [open $flist r]} ]  {
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

#
set where [pwd]
set XTempDir "$TempDir/VArj"
catch [exec mkdir $XTempDir]
cd $XTempDir
set rc [catch {exec unarj x $TheFile >$lstf 2>$errf} cc]
foreach fn $xlist  {
if { ! [file exists $fn] }  {
  set fn [string tolower $fn]
  }
  catch [exec cp $XTempDir/$fn $whereto]
  catch [exec rm $XTempDir/$fn]
  }
$statw configure -fg black
set $stat "   Done   "
catch { [exec rm $lstf $errf $flist] }

cd $where
return $rc
}




#--------------------------------------------------------------
#  The Rar Handling Routines --  Handle RAR archive files
#
#--------------------------------------------------------------

#--------------------------------------------------------------
#  GetDirRar  --  Get the Archive Directory list data for a RAR
#
#--------------------------------------------------------------
proc GetDirRar {owner dirname arcname dummyname errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir

set thisproc "GetDirRar"
set thiswin $owner
set WinName ".$owner"
set topf "$WinName.top"
set archdr "$WinName.hdr"
set arcbody "$WinName.body"
set fv "ArcFno$thiswin"
global $fv
set ArcFno [set $fv]
set WButBg [lindex $TButBg $ArcFno]
# incr TmpNo
set tno $TmpNo
set tmpf "$TempDir/TkzTmp$tno"
# set errf "$TempDir/TkzErr$tno"

#  Oh, bother! unrar is another dumb old DOS-style pgm that insists on a ".rar" extension...
set temprar "TmpRar$owner"
global $temprar
set temprarfile "$TempDir/Trar$tno.rar"
set $temprar $temprarfile


set ap "ArcPgm$thiswin"
set lf "ListFlags$thiswin"
global $ap $lf
set arcpgm [set $ap]
set listflags [set $lf]

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev"}  {
#  set tmp [string last "/" $tmparc]
#  incr tmp
#  set TheArcFile [string range $tmparc $tmp end]
  set TheArcFile $tmparc
  }


# set arcpgm "unrar"
# set listflags "l"

#--------------------
# Now read the list...
##	set rc [ catch { set in [ open [ concat "|$arcpgm $listflags $dirname/$arcname 2>$errf" ] r ] } cc]
#	set rc [ catch { set in [ open [ concat "|unrar l $dirname/$arcfile 2>$errf" ] r ] } cc]
        #  So if it doesn't end in .rar, make it so, or unrar will whine.
        set tmp [string length $arcname]
        incr tmp -4
        set tmp2 [string last ".rar" $arcname]
        if {$tmp != $tmp2}  {
          set rc [ catch { exec cp $TheArcFile $temprarfile } cc ]
          set rc [ catch { set in [ open [ concat "|unrar l $temprarfile 2>$errf" ] r ] } cc]
          }  else  {
          set rc [ catch { set in [ open [ concat "|unrar l $TheArcFile 2>$errf" ] r ] } cc]
          }
	if {$rc != 0}  {
          #  The caller needs to take the appropriate action here...
          #  just tell him nfg...
	  return -1
	  }

        set dfltwidth 80
        set hdrwidth 0
        set hdrflds 10
        set llen 0
        set ll1 0
        set fl1 0
	set lineno 0
	set ignline 1
	set startdata 0
        while  { [ gets $in line ] > -1 } {
          set ll1 [expr [string length $line] ]
	  #  Customize the column headings for the archive type from listing data in this loop...
	  incr lineno
          set tempfl1 [ string length [lindex $line 1] ]
          if {$tempfl1 > $fl1}  {
            set fl1 $tempfl1
            }
	  if { [string first "Name" $line] == 1 }  {
	    set hf1 1
	    set hf1a 0

	    while {$hf1a < $hdrflds}  {
	      set fname "$archdr.h$hf1"
	      label $fname -relief groove
	      $fname configure -bg $WButBg -highlightbackground $WButBg -text [ lindex $line $hf1a ]
              incr hf1
              incr hf1a
	      }

            incr fl1 8
            $archdr.h1 configure -width $fl1
            $archdr.h2 configure -width 8
            $archdr.h3 configure -width 8
            $archdr.h4 configure -width 6
            $archdr.h5 configure -width 8
            $archdr.h6 configure -width 6
            $archdr.h7 configure -width 6
            $archdr.h8 configure -width 8
            $archdr.h9 configure -width 5
            $archdr.h10 configure -width 3

	    pack $archdr.h1 $archdr.h2 $archdr.h3 $archdr.h4 $archdr.h5 $archdr.h6 $archdr.h7 $archdr.h8 $archdr.h9 -side left  
	    pack $archdr.h10 -anchor w -side left -fill x -expand yes

            }
          if { [string first "--------" $line] == 0 }  {
            #  Stop or resume ignoring data lines...
            if {$ignline}  {
              set startdata 1
              }  else  {
              set ignline 1
              set startdata 0
              }
            }
          if {! $ignline}  {	  
            #  Ignore broken rar msg - it will always happen if we've copied from a device)
            if {[string first "Program aborted" $line] < 0 && [string first "Broken archive" $line] < 0}  {
              $arcbody.alist insert end $line
              #  Keep track of widest line...
              if { $ll1 > $llen } {
                set llen $ll1
                }
              }
            }
           if { $startdata }  {
             set ignline 0
             }
          }
        catch { close $in }
#  I think this should be about it for the data....
#  Now, what about error checking and window size configure...?
#  Well, only Zip needs some special checking at this point.

#  Window size - may need xscrollbar...
        if {$hdrwidth > $dfltwidth}  {
          set dfltwidth $hdrwidth
          }
	if { $llen > $dfltwidth } {
	  set ll1 $llen
	  set llen $dfltwidth
          scrollbar $arcbody.scrollx -orient horizontal -command "$arcbody.alist xview"
          $arcbody.alist configure -xscroll "$arcbody.scrollx set"
	  }

        $arcbody.alist configure -width $llen
        if { $ll1 > $llen } {
	  pack $arcbody.scrollx -fill x -side bottom
	  } 
#  Do we want to do this here...?
        pack $arcbody.alist  -side left -fill both -expand yes
#--------------------


return 1
}

#--------------------------------------------------------------
#  GetVRar  --  Get a member to view from a RAR
#
#--------------------------------------------------------------
proc GetVRar {owner dirname arcname flist tmpd errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir
set thisproc "GetVRar"

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev"}  {
#  set tmp [string last "/" $tmparc]
#  incr tmp
#  set TheArcFile [string range $tmparc $tmp end]
  set TheArcFile $tmparc
  }

set temprar "TmpRar$owner"
global $temprar
set temprarfile [set $temprar]

#  Make sure unrar will like the filename...
set tmp [string length $arcname]
incr tmp -4
set tmp2 [string last ".rar" $arcname]
if {$tmp != $tmp2}  {
  set TheFile $temprarfile
  }  else  {
  set TheFile $TheArcFile
  }

#  Can't extract to stdout or to a specific name - put in tmp dir & copy...
#set where [pwd]
#cd $TempDir
#set rc [catch {exec unrar x $TheFile $fname >$errf 2>$errf} cc]
#cd $where
#set crc [catch {exec cp $TempDir/$fname $tmpf} cc]
#catch [exec rm $TempDir/$fname]
#if {$rc > 0}  {
#  set rc 0
#  }
set errc 0
set where [pwd]
set xlist ""
if [ catch {set fl [open $flist r]} ]  {
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

cd $tmpd
foreach fn $xlist  {
  set rc [catch {exec unrar x $TheFile $fn >$errf 2>$errf} cc]
  if {$rc != 0}  {
    cd $where
    return $rc
    }
  }
cd $where

return $rc
}

#-----------------------------------------------------------------
#  ExtRar  --  Extract member(s) from a RAR
#     -- I don't know whether rar will store directory entries --
#        for now, we don't support extracting such entries if they
#        do exist.
#-----------------------------------------------------------------
proc ExtRar {owner dirname arcname whereto fname flist lstf errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir
set thisproc "ExtRar"
set statw ".$owner.top.vopt.stat"
set stat "Stat$owner"
global $stat
set $stat "          "
$statw configure -textvariable $stat -fg red

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev"}  {
#  set tmp [string last "/" $tmparc]
#  incr tmp
#  set TheArcFile [string range $tmparc $tmp end]
  set TheArcFile $tmparc
  }

set temprar "TmpRar$owner"
global $temprar
set temprarfile [set $temprar]

#  Make sure unrar will like the filename...
set tmp [string length $arcname]
incr tmp -4
set tmp2 [string last ".rar" $arcname]
if {$tmp != $tmp2}  {
  set TheFile $temprarfile
  }  else  {
  set TheFile $TheArcFile
  }

#  Pay no attention to fname, we may have a lotta files to extract...
#  gotta access the list of member names to extract.
#  For each file in list, just extract in the target dir.

set $stat "Extracting"
$statw configure -fg red
update idletasks
set xlist ""
if [ catch {set fl [open $flist r]} ]  {
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

set where [pwd]
cd $whereto
foreach fn $xlist  {
  set rc [catch {exec unrar x $TheFile $fn >$lstf 2>$errf} cc]
  }

$statw configure -fg black
set $stat "   Done   "
catch { [exec rm $lstf $errf $flist] }

cd $where
return $rc
}



#--------------------------------------------------------------
#  The Shorten Handling Routines --  Handle Shorten files
#
#--------------------------------------------------------------

#--------------------------------------------------------------
#  GetDirShn  --  Get the Archive Directory list data for a SHN
#
#--------------------------------------------------------------
proc GetDirShn {owner dirname arcname dummyname errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir

set thisproc "GetDirShn"
set thiswin $owner
set WinName ".$owner"
set topf "$WinName.top"
set archdr "$WinName.hdr"
set arcbody "$WinName.body"
set fv "ArcFno$thiswin"
global $fv
set ArcFno [set $fv]
set WButBg [lindex $TButBg $ArcFno]
# incr TmpNo
set tno $TmpNo
set tmpf "$TempDir/TkzTmp$tno"
# set errf "$TempDir/TkzErr$tno"

set ap "ArcPgm$thiswin"
set lf "ListFlags$thiswin"
global $ap $lf
set arcpgm [set $ap]
set listflags [set $lf]


set arcpgm "shorten"
set listflags "-x"

#  Shorten is even more of a no-brainer than ar.... 
#  There is no listing, no info, not even the original file name. We don't even 
#  need to read the file. Shorten is fairly primitive, so...
#


set nlen [expr [string length $arcname] ]
incr nlen -4
if {[string range $arcname $nlen end] == ".shn"}  {
  incr nlen -1
  set line [string range $arcname 0 $nlen]
  }  else {
  set line $arcname
  }

label $archdr.h1 -relief groove
pack $archdr.h1 -anchor w -side left -fill x -expand yes
$archdr.h1 configure -bg $WButBg -highlightbackground $WButBg -text "           Name        "
$archdr.h1 configure -bg $WButBg -highlightbackground $WButBg \
  -text "  Name       (Possibly lossy algorithm: uncompressed file may not match original.)"
$arcbody.alist insert end $line
#  Thatz all, folks....
#  Now, what about error checking and window size configure...?

#  Window size - don't need xscrollbar...
        $arcbody.alist configure -width 80
#  Do we want to do this here...?
        pack $arcbody.alist  -side left -fill both -expand yes



return 1
}

#--------------------------------------------------------------
#  GetVShn  --  Get a member to view from a SHN
#
#--------------------------------------------------------------
proc GetVShn {owner dirname arcname flist tmpd errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir
set thisproc "GetVShn"

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" }  {
#  set tmp [string last "/" $tmparc]
#  incr tmp
#  set TheArcFile [string range $tmparc $tmp end]
  set TheArcFile $tmparc
  }


#  Can't extract to stdout or to a specific name - put in tmp dir & copy...

#set where [pwd]
#cd $TempDir
#
#set rc [catch {exec shorten -x $TheArcFile $fname 2>$errf} cc]
#cd $where
#catch [exec cp $TempDir/$fname $tmpf]
#catch [exec rm $TempDir/$fname]
set errc 0
set where [pwd]
set xlist ""
if [ catch {set fl [open $flist r]} ]  {
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

cd $tmpd
foreach fn $xlist  {
  set tmpf "$tmpd/$fn"
  set rc [catch {exec shorten -x $TheArcFile $tmpf 2>$errf} cc]

  if {$rc > 0}  {
    set rc 0
    }
  if {$rc != 0}  {
    cd $where
    return $rc
    }
  }

cd $where
return $rc
}

#--------------------------------------------------------------
#  ExtShn  --  Extract member(s) from a SHN
#
#--------------------------------------------------------------
proc ExtShn {owner dirname arcname whereto fname flist lstf errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir
set thisproc "ExtShn"
set statw ".$owner.top.vopt.stat"
set stat "Stat$owner"
global $stat
set $stat "          "
$statw configure -textvariable $stat -fg red

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev"  }  {
#  set tmp [string last "/" $tmparc]
#  incr tmp
#  set TheArcFile [string range $tmparc $tmp end]
  set TheArcFile $tmparc
  }

#  Just go to the target dir and extract...
#  Pay no attention to flist, there's only one file to extract...
set where [pwd]
cd $whereto
set $stat "Extracting"
$statw configure -fg red
update idletasks
set rc [catch {exec shorten -x $TheArcFile $fname >$lstf 2>$errf} cc]
$statw configure -fg black
set $stat "   Done   "
catch { [exec rm $lstf $errf $flist] }

cd $where
return $rc
}

#--------------------------------------------------------------
#  AddShn  --  "Add" to a shorten File
#    Called Add for consistency, it's really just Compress.
#    It gets a filelist with one member.
#
#    Options supported:
#        None at present...  
#--------------------------------------------------------------
proc AddShn {parent owner dirname arcname flist lstf errf} {
set thisproc "AddShn"
global PgmName ErrArgs ShnHeur


#set tmp "creating$parent"
#global $tmp
#set creating [set $tmp]
#set tmp "apn$owner"
#global $tmp
#set apn [set $tmp]
#set tmp "recurs$owner"
#global $tmp
#set recurs [set $tmp]
set tmp "ArcFno$parent"
global $tmp
set type [set $tmp]
set rc 0
set TheArcFile $dirname/$arcname
set xlist ""

if [ catch {set fl [open $flist r]} ]  {
  puts "$thisproc:    open failure"
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

set align ""
set flags ""
foreach fn $xlist  {
  set rc [catch {exec shorten $fn $TheArcFile >$lstf 2>$errf} cc]
  if {$rc != 0}  {
    break
    }
  }

if {$rc != 0}  {
  if {$ShnHeur}  {
    #  If at first you don't succeed...
    set errtxt [exec cat $errf]
    set o1 [string first " extra bytes" $errtxt]
    if {$o1 != -1}  {
      set o2 $o1
      while {[string index $errtxt $o2] == " "}  {
        incr o2 -1
        }
      set o1 $o2
      while {[string index $errtxt $o1] != " "}  {
        incr o1 -1
        }
      incr o1
      set align [string range $errtxt $o1 $o2]
      set line "\n#--------\n$PgmName will heuristically try an option of -a$align\n#--------\n"
      catch [exec echo "$line" >>$errf]
      set rc [catch {exec shorten -a$align $fn $TheArcFile >>$lstf 2>>$errf} cc]
      if {$rc == 0}  {
        set ErrArgs "$TheArcFile -a$align"
        GErrMsgBox 86
        }
      }
    }
  if {$rc != 0}  {
    set ErrArgs "$lstf $errf $TheArcFile"
    GErrMsgBox 89
    return $rc
    }
  }


return $rc
}




#----------------------------------
#  The next ones to do...
#----------------------------------



#--------------------------------------------------------------
#  The Zip Handling Routines --  Handle Zip files
#
#--------------------------------------------------------------

#--------------------------------------------------------------
#  GetDirZip  --  Get the Archive Directory list data for a ZIP
#
#--------------------------------------------------------------
proc GetDirZip {owner dirname arcname dummyname errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir

set thisproc "GetDirZip"
set thiswin $owner
set WinName ".$owner"
set topf "$WinName.top"
set archdr "$WinName.hdr"
set arcbody "$WinName.body"
set fv "ArcFno$thiswin"
global $fv
set ArcFno [set $fv]
set WButBg [lindex $TButBg $ArcFno]
# incr TmpNo
set tno $TmpNo
set tmpf "$TempDir/TkzTmp$tno"
# set errf "$TempDir/TkzErr$tno"

set ap "ArcPgm$thiswin"
set lf "ListFlags$thiswin"
global $ap $lf
set arcpgm [set $ap]
set listflags [set $lf]

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
#  Zip doesn't like to read from devices at all...
if { $dirname == "/dev" }  {
    set TheArcFile $tmparc
  }


# set arcpgm "unzip"
# set listflags "-v"

#--------------------
# Now read the list...
#	set rc [ catch { set in [ open [ concat "|$arcpgm $listflags $dirname/$arcname 2>$errf" ] r ] } cc]
	set rc [ catch { set in [ open [ concat "|unzip -v $TheArcFile 2>$errf" ] r ] } cc]
	if {$rc != 0}  {
          #  The caller needs to take the appropriate action here...
          #  just tell him nfg...
	  return -1
	  }

        set dfltwidth 80
        set hdrwidth 0
        set hdrflds 8
        set llen 0
        set ll1 0
        set fl1 0
	set lineno 0
	set ignline 1
	set startdata 0
        while  { [ gets $in line ] > -1 } {
          set ll1 [expr [string length $line] ]
	  #  Customize the column headings for the archive type from listing data in this loop...
	  incr lineno
          set tempfl1 [ string length [lindex $line 1] ]
          if {$tempfl1 > $fl1}  {
            set fl1 $tempfl1
            }
	  if { [string first "Length" $line] == 1 }  {
	    set hf1 1
	    set hf1a 0

	    while {$hf1a < $hdrflds}  {
	      set fname "$archdr.h$hf1"
	      label $fname -relief groove
	      $fname configure -bg $WButBg -highlightbackground $WButBg -text [ lindex $line $hf1a ]
              incr hf1
              incr hf1a
	      }


            }
          if { [string first "------" $line] == 0 || [string first "------" $line] == 1 }  {
            #  Stop or resume ignoring data lines...
            if {$ignline}  {
              set startdata 1
            $archdr.h1 configure -width 8
            $archdr.h2 configure -width 7
            $archdr.h3 configure -width 8
            $archdr.h4 configure -width 5
            $archdr.h5 configure -width 8
            $archdr.h6 configure -width 7
            $archdr.h7 configure -width 10
            $archdr.h8 configure -width 8
	    pack $archdr.h1 $archdr.h2 $archdr.h3 $archdr.h4 $archdr.h5 $archdr.h6 $archdr.h7 -side left  
	    pack $archdr.h$hdrflds -anchor w -side left -fill x -expand yes
              }  else  {
              set ignline 1
              set startdata 0
              }
            }
          if {! $ignline}  {	  
            $arcbody.alist insert end $line
            #  Keep track of widest line...
            if { $ll1 > $llen } {
              set llen $ll1
              }
            }
           if { $startdata }  {
             set ignline 0
             }
          }
        catch { close $in }
#  I think this should be about it for the data....
#  Now, what about error checking and window size configure...?
#  Well, Zip needs some special checking at this point.
if {$lineno < 2}  {
  return -2
  }

#  Window size - may need xscrollbar...
        if {$hdrwidth > $dfltwidth}  {
          set dfltwidth $hdrwidth
          }
#	if { $llen > $dfltwidth } {
#	  set ll1 $llen
#	  set llen $dfltwidth
          scrollbar $arcbody.scrollx -orient horizontal -command "$arcbody.alist xview"
          $arcbody.alist configure -xscroll "$arcbody.scrollx set"
#	  }

        $arcbody.alist configure -width $llen
#        if { $ll1 > $llen } {
	  pack $arcbody.scrollx -fill x -side bottom
#	  } 
#  Do we want to do this here...?
        pack $arcbody.alist  -side left -fill both -expand yes
##--------------------


return 1
}

#--------------------------------------------------------------
#  GetVZip  --  Get a member to view from a ZIP
#
#--------------------------------------------------------------
proc GetVZip {owner dirname arcname flist tmpd errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir
set thisproc "GetVZip"

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" }  {
  set TheArcFile $tmparc
  }

#  Extract to stdout as tmp file...
#-------------
set errc 0
set where [pwd]
set xlist ""
if [ catch {set fl [open $flist r]} ]  {
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

cd $tmpd
foreach fn $xlist  {
  set tmpf "$tmpd/$fn"
    set l1 [string last "/" $fn]
    if {$l1 != -1}  {
      incr l1
      set sfn [string range $fn $l1 end]
      }  else  {
      set sfn $fn
      }
  set rc [catch {exec unzip -pj $TheArcFile $fn >$sfn  2>$errf} cc]
  #  Zip is a nice program - no more dorking around needed!
  if {$rc != 0}  {
    cd $where
    return $rc
    }
  }
#------------

if {$rc > 0}  {
  set rc 0
  }
cd $where
return $rc
}

#--------------------------------------------------------------
#  ExtZip  --  Extract member(s) from a ZIP
#
#--------------------------------------------------------------
proc ExtZip {owner dirname arcname whereto fname flist lstf errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir
set thisproc "ExtZip"
set statw ".$owner.top.vopt.stat"
set stat "Stat$owner"
global $stat
set $stat "          "
set fv "ArcFno$owner"
global $fv
set ArcFno [set $fv]
if {$ArcFno == 2}  {
  set vred "red"
  }  else  {
  #  Because the background on that one is also red...
  #  so call this virtual red.
  set vred "green"
  }

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" }  {
  set TheArcFile $tmparc
  }
set tmp "sdirl$owner"
global $tmp
set flist3 [set $tmp]
set rc 0


$statw configure -textvariable $stat -fg $vred

#  Pay no attention to fname, we may have a lotta files to extract...
#  gotta access the list of member names to extract.
#  For each file in list, just extract in the target dir.
set $stat "Extracting"
$statw configure -fg $vred

update idletasks
set xlist ""
if [ catch {set fl [open $flist r]} ]  {
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

set where [pwd]
cd $whereto
foreach fn $xlist  {
  set rc [catch {exec unzip -o $TheArcFile $fn >$lstf 2>$errf} cc]
  }
#------------
  if {! $rc && $flist3 != ""}  {
    foreach fn $flist3  {
      set rc [catch {exec unzip -o $TheArcFile $fn >>$lstf 2>>$errf} cc]
      }
    }
#------------

$statw configure -fg black
set $stat "   Done   "
catch { [exec rm $lstf $errf $flist] }

cd $where
return $rc
}

#--------------------------------------------------------------
#  DelZip  --  Delete member(s) from a ZIP
#
#--------------------------------------------------------------
proc DelZip {owner dirname arcname flist lstf errf} {
set thisproc "DelZip"
global ErrArgs

set TheArcFile $dirname/$arcname
set xlist ""
if [ catch {set fl [open $flist r]} ]  {
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

foreach fn $xlist  {
  set rc [catch {exec zip -d $TheArcFile $fn >$lstf 2>$errf} cc]
  if {$rc != 0}  {
    break
    }
  }

if {$rc != 0}  {
  set ErrArgs "$lstf $errf $TheArcFile"
  GErrMsgBox 87
  return $rc
  }

return $rc
}

#--------------------------------------------------------------
#  AddZip  --  Add member(s) to a ZIP
#
#    Options supported:
#        Loose or keep pathnames  --  default: keep pathnames
#        Recurse subdirectories?  --  default: no
#--------------------------------------------------------------
proc AddZip {parent owner dirname arcname flist lstf errf} {
set thisproc "AddZip"
global ErrArgs

set tmp "creating$parent"
global $tmp
set creating [set $tmp]
set tmp "jpn$owner"
global $tmp
set jpn [set $tmp]
set tmp "apn$owner"
global $tmp
set apn [set $tmp]
set tmp "recurs$owner"
global $tmp
set recurs [set $tmp]

set TheArcFile $dirname/$arcname
set xlist ""
set where [pwd]

if [ catch {set fl [open $flist r]} ]  {
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

set flags ""
#  Zip doesn't seem to allow absolute pathnames anyway...
#  unless it has a compile option to cause it to.
if {! $apn && ! $jpn}  {
  cd "/"
  }

foreach fn $xlist  {
  if {! $jpn}  {
    if {! $apn}  {
      set fn [string range $fn 1 end]
      }
    if {! $recurs}  {
      set rc [catch {exec zip $TheArcFile $fn >$lstf 2>$errf} cc]
      }  else  {
      set rc [catch {exec zip -r $TheArcFile $fn >$lstf 2>$errf} cc]
      }
    }  else  {
    if {! $recurs}  {
      set rc [catch {exec zip -j $TheArcFile $fn >$lstf 2>$errf} cc]
      }  else  {
      set rc [catch {exec zip -jr $TheArcFile $fn >$lstf 2>$errf} cc]
      }
    }
  if {$rc != 0}  {
    break
    }
  }

cd $where
if {$rc != 0}  {
  set ErrArgs "$lstf $errf $TheArcFile"
  GErrMsgBox 88
  return $rc
  }

return $rc
}




#--------------------------------------------------------------
#  The Tar Handling Routines --  Handle Tar files
#    - new structure will make it much cleaner to deal with
#      different styles of tar
#
#--------------------------------------------------------------

#--------------------------------------------------------------
#  GetDirTar  --  Get the Archive Directory list data for a TAR
#
#--------------------------------------------------------------
proc GetDirTar {owner dirname arcname dummyname errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir

set thisproc "GetDirTar"
set thiswin $owner
set WinName ".$owner"
set topf "$WinName.top"
set archdr "$WinName.hdr"
set arcbody "$WinName.body"
set fv "ArcFno$thiswin"
global $fv
set ArcFno [set $fv]
    set WBg [lindex $TBg $ArcFno]
set WButBg [lindex $TButBg $ArcFno]
    set WFg [lindex $TFg $ArcFno]
# incr TmpNo
set tno $TmpNo
set tmpf "$TempDir/TkzTmp$tno"
# set errf "$TempDir/TkzErr$tno"

set ap "ArcPgm$thiswin"
set lf "ListFlags$thiswin"
global $ap $lf
set arcpgm [set $ap]
set listflags [set $lf]
set tmp "SimpleCmp$thiswin"
global $tmp
set simple [set $tmp]


set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" && [string first "n" $arcname] == 0 }  {
#  set tmp [string last "/" $tmparc]
#  incr tmp
#  set TheArcFile [string range $tmparc $tmp end]
  set TheArcFile $tmparc
  }


#  Oh, pain...
#  Gotta reset these because we may have come in from the Gzip or Compress routines
if {$dummyname != "dummy"}  {
  $topf configure -bg $WBg -highlightbackground $WBg
  set buttons "$topf.but"
  set vopts "$topf.vopt"

  $buttons configure -bg $WButBg
  $buttons.quit configure -bg $WButBg -highlightbackground $WButBg
  $buttons.selall configure -bg $WButBg -highlightbackground $WButBg
  $buttons.view configure -bg $WButBg -highlightbackground $WButBg
  $buttons.ext configure -bg $WButBg -highlightbackground $WButBg
  $buttons.add configure -bg $WButBg -highlightbackground $WButBg
  $buttons.del configure -bg $WButBg -highlightbackground $WButBg
  $buttons.selv configure -bg $WButBg -highlightbackground $WButBg
  $buttons.selv.m configure -bg $WButBg

  $vopts.vname configure -bg $WButBg -highlightbackground $WButBg
  $vopts.vbin configure -bg $WButBg -highlightbackground $WButBg

  $vopts configure -bg $WBg -highlightbackground $WBg
  $vopts.vndsc configure -bg $WBg -highlightbackground $WBg -fg $WFg
  $vopts.vbdsc configure -bg $WBg -highlightbackground $WBg -fg $WFg
  $vopts.stat configure -bg $WBg -highlightbackground $WBg -fg $WFg
  $arcbody.alist configure -selectbackground $WBg
  $arcbody.alist configure -selectforeground $WFg
  #  If this is a complex archive, so indicate...
#  if {$simple}  {
    set tmp "SimpleCmp$thiswin"
    $buttons.add configure -state normal
    set simple 0
    set $tmp $simple
#    }
  }

# set arcpgm "tar"
# set listflags "-tvf"

#--------------------
# Now read the list...
        if {$dummyname == "dummy"}  {
	  set rc [ catch { set in [ open [ concat "|tar -tvf $TheArcFile 2>>$errf" ] r ] } cc]
	  }  else  {
	  set rc [ catch { set in [ open [ concat "|tar -tvf $dummyname 2>>$errf" ] r ] } cc]
	  }

	if {$rc != 0}  {
          #  The caller needs to take the appropriate action here...
          #  just tell him nfg...
	  return -1
	  }

        set dfltwidth 80
        set hdrwidth 0
        set hdrflds 5
        set llen 0
        set ll1 0
        set fl1 0
#--------------------------
        set fl1 11
        set fl2 11
        set fl3 8
        set fl4 8
        set fl5 8
#--------------------------
	set lineno 0
	set ignline 1
	set startdata 0
	# Heading for tar...
	label $archdr.h1 -relief groove
	label $archdr.h2 -relief groove
	label $archdr.h3 -relief groove
	label $archdr.h4 -relief groove
	label $archdr.h5 -relief groove
	pack $archdr.h1 $archdr.h2 $archdr.h3 $archdr.h4 -side left  
	pack $archdr.h5 -anchor w -side left -fill x -expand yes
	$archdr.h1 configure -bg $WButBg -highlightbackground $WButBg -text "   Perm       "
	$archdr.h2 configure -bg $WButBg -highlightbackground $WButBg -text "  Owner/Grp  "
	$archdr.h3 configure -bg $WButBg -highlightbackground $WButBg -text "  Size    " 
	$archdr.h4 configure -bg $WButBg -highlightbackground $WButBg -text "          Date             " 
	$archdr.h5 configure -bg $WButBg -highlightbackground $WButBg -text "           Name        "
	# End tar heading...
        while  { [ gets $in line ] > -1 } {
          #  Adapt column widths to actual data found...
          set fc 0
          while {$fc < $hdrflds}  {
            set fld [lindex $line $fc]
            set fl [string length [lindex $line $fc]]
            incr fc
            set fln "fl$fc"
            if {$fl > [set $fln]}  {
               set $fln $fl
               }
            }
          $arcbody.alist insert end $line
          }
        catch { close $in }
#  I think this should be about it for the data....
#  Now, what about error checking and window size configure...?
#  Well, only Zip needs some special checking at this point.

#----------------------------
#  Temp stuff -- get all the columns of data reasonably aligned with headings
#  This needs to be cleaned up, then generalized for all the directory functions...
set fc 0
while {$fc < 3}  {
  incr fc
  set fln "fl$fc"
  set fl [set $fln]
  $archdr.h$fc configure -width $fl
#  puts "$thisproc:    Field $fc length should be $fl "  
  }
#  ToDo --
#    - read the whole goddam listbox, reformatting every entry...tar isn't
#      too finicky about field alignment.
#      - fields 2 (owner) and 3 (size) are the problem ones...
#        fld2 needs to be left justified, fld3 right justified
set lsize [$arcbody.alist size]
set lineno 0
while {$lineno < $lsize}  {
  set line [$arcbody.alist get 0]
  set fp 0
  set fld1 [lindex $line 0]
  set fpincr [string length $fld1]
  set fp [string first $fld1 [string range $line $fp end]]
  incr fp $fpincr

  set fld2 "[lindex $line 1]                    "
  set fpincr [string length [lindex $line 1]]
  set tfp [string first [lindex $line 1] [string range $line $fp end]]
  incr fp $tfp
  incr fp $fpincr

  set fld2 [string range $fld2 0 $fl2]
  set fld3 [lindex $line 2]
  set fpincr [string length $fld3]
  set tfp [string first $fld3 [string range $line $fp end]]
  incr fp $tfp
  incr fp $fpincr

  set tmpl [string length $fld3]
  set tmp2 "                "
  set tmpl2 [string length $tmp2]
  set tmpl2 [expr $fl3 - $tmpl]
  incr tmpl2 -2
  set tmp2 [string range $tmp2 0 $tmpl2]
  set fld3 "$tmp2$fld3"

  #  Get rest of line...
  set fld4 [string range $line $fp end]
  set line "$fld1 $fld2 $fld3 $fld4"
  #  and replace the current listbox entry...
  $arcbody.alist delete 0
  $arcbody.alist insert end $line

  incr lineno
  }

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

#  Window size - may need xscrollbar...
        if {$hdrwidth > $dfltwidth}  {
          set dfltwidth $hdrwidth
          }
#	if { $llen > $dfltwidth } {
#	  set ll1 $llen
#	  set llen $dfltwidth
          scrollbar $arcbody.scrollx -orient horizontal -command "$arcbody.alist xview"
          $arcbody.alist configure -xscroll "$arcbody.scrollx set"
#	  }

#        $arcbody.alist configure -width $llen
#        if { $ll1 > $llen } {
	  pack $arcbody.scrollx -fill x -side bottom
#	  } 
#  Do we want to do this here...?
        pack $arcbody.alist  -side left -fill both -expand yes

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


return 1
}

#--------------------------------------------------------------
#  GetVTar  --  Get a member to view from a TAR
#
#--------------------------------------------------------------
proc GetVTar {owner dirname arcname flist tmpd errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir
set thisproc "GetVTar"

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" && [string first "n" $arcname] == 0 }  {
#  set tmp [string last "/" $tmparc]
#  incr tmp
#  set TheArcFile [string range $tmparc $tmp end]
  set TheArcFile $tmparc
  }

#  If this was a gzipped or compressed tar, then we already have an uncompressed
#  copy lying around, so use it...
set temptar "TmpTar$owner"
global $temptar
set temptarfile [set $temptar]

#  Extract to stdout as tmp file...
#set where [pwd]
#cd $TempDir
#if {$temptarfile == ""}  {
#  set rc [catch {exec tar -xOf $TheArcFile $fname >$tmpf 2>$errf} cc]
#  }  else  {
#  set rc [catch {exec tar -xOf $temptarfile $fname >$tmpf 2>$errf} cc]
#  }

#-------------------
set errc 0
set where [pwd]
set xlist ""
if [ catch {set fl [open $flist r]} ]  {
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

cd $tmpd
foreach fn $xlist  {
    set tmpf "$tmpd/$fn"
    set l1 [string last "/" $fn]
    if {$l1 != -1}  {
      incr l1
      set sfn [string range $fn $l1 end]
      }  else  {
      set sfn $fn
      }
    if {$temptarfile == ""}  {
      set rc [catch {exec tar -xOf $TheArcFile $fn >$sfn 2>$errf} cc]
      }  else  {
      set rc [catch {exec tar -xOf $temptarfile $fn >$sfn 2>$errf} cc]
      }

  if {$rc != 0}  {
    cd $where
    return $rc
    }
  }
  cd $where
#-------------------

cd $where
if {$rc > 0}  {
  set rc 0
  }
return $rc
}

#--------------------------------------------------------------
#  ExtTar  --  Extract member(s) from a TAR
#
#--------------------------------------------------------------
proc ExtTar {owner dirname arcname whereto fname flist lstf errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir
global GotGtar MyPid Home ErrArgs IgnITG DseFlag ExtDirs
set thisproc "ExtTar"
set statw ".$owner.top.vopt.stat"
set stat "Stat$owner"
global $stat
set $stat "          "
$statw configure -textvariable $stat -fg red
set tmp "sdirl$owner"
global $tmp
set flist3 [set $tmp]

#  In case we already copied the file from a tape...
set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" && [string first "n" $arcname] == 0 }  {
#  set tmp [string last "/" $tmparc]
#  incr tmp
#  set TheArcFile [string range $tmparc $tmp end]
  set TheArcFile $tmparc
  }

#  If this was a gzipped or compressed tar, then we already have an uncompressed
#  copy lying around, so use it...
set temptar "TmpTar$owner"
global $temptar
set temptarfile [set $temptar]
if {$temptarfile == ""}  {
  set thefile "$TheArcFile"
  }  else  {
  set thefile $temptarfile
  }

#  Pay no attention to fname, we may have a lotta files to extract...
#  gotta access the list of member names to extract.
#  For each file in list, just extract in the target dir.

set $stat "Extracting"
$statw configure -fg red
update idletasks
set where [pwd]
cd $whereto

if {$GotGtar}  {
  #  This is the thing to do for Gnu tar...
  #  for others we may have to do 'em one at a time.
  #  (If we extract directory entries, we have to avoid confusing GNU tar, so
  #  we do directories in a separate pass.)
  set rc [catch {exec tar -xvf $thefile -T $flist >$lstf 2>$errf} cc]
#------------
  if {! $rc && $flist3 != ""}  {
    if [ catch {set fl [open $flist w]} ]  {
      return -1
      }
    foreach file $flist3  {
      puts $fl "$file"
      }
    catch [close $fl]
    set rc [catch {exec tar -xvf $thefile -T $flist >>$lstf 2>>$errf} cc]
    }

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

#----------------------------------
#  Archetypal error check...
#----------------------------------
  if {$rc != 0} {
    set ignerr 0
    if {$IgnITG}  {
      set dummy ""
      catch {set dummy [exec cat $errf]}
      if {[string first "trailing garbage" $dummy] != -1}  {
        set ignerr 1
        }
      }
    if {! $ignerr}  {
      incr TmpNo
      set tno $TmpNo
      if {! $DseFlag}  {
        catch [exec cp $lstf $Home/TkzLst$MyPid-$tno]
        catch [exec cp $errf $Home/TkzErr$MyPid-$tno]
        }
      set ErrArgs "$Home/TkzLst$MyPid-$tno $Home/TkzErr$MyPid-$tno $lstf $errf"
      $statw configure -bg black
      set $stat "Done"
      GErrMsgBox 91
      return -1
      }
    }
#----------------------------------
  }  else  {
  #  If we find any other tars that accept a list in a file, we'll
  #  change this...
  set xlist ""
  if [ catch {set fl [open $flist r]} ]  {
    return -1
    }
  while {[ gets $fl line ] > -1}  {
    set xlist "$xlist $line"
    }
  catch [close $fl]
  
  foreach fn $xlist  {
    set rc [catch {exec tar -xvf $thefile $fn >>$lstf 2>>$errf} cc]
#----------------------------------
#  Archetypal error check...
#----------------------------------
    if {$rc != 0} {
      set ignerr 0
      if {$IgnITG}  {
        set dummy ""
        catch {set dummy [exec cat $errf]}
        if {[string first "trailing garbage" $dummy] != -1}  {
          set ignerr 1
          }
        }
      if {! $ignerr}  {
        incr TmpNo
        set tno $TmpNo
        if {! $DseFlag}  {
          catch [exec cp $lstf $Home/TkzLst$MyPid-$tno]
          catch [exec cp $errf $Home/TkzErr$MyPid-$tno]
          }
        set ErrArgs "$Home/TkzLst$MyPid-$tno $Home/TkzErr$MyPid-$tno $lstf $errf"
        $statw configure -bg black
        set $stat "Done"
        GErrMsgBox 91
        return -1
        }
      }
#----------------------------------
    }
#------------
  if {! $rc && $flist3 != ""}  {
    foreach fn $flist3  {
      set rc [catch {exec tar -xvf $thefile $fn >>$lstf 2>>$errf} cc]
#----------------------------------
#  Archetypal error check...
#----------------------------------
      if {$rc != 0} {
        set ignerr 0
        if {$IgnITG}  {
          set dummy ""
          catch {set dummy [exec cat $errf]}
          if {[string first "trailing garbage" $dummy] != -1}  {
            set ignerr 1
            }
          }
        if {! $ignerr}  {
          incr TmpNo
          set tno $TmpNo
          if {! $DseFlag}  {
            catch [exec cp $lstf $Home/TkzLst$MyPid-$tno]
            catch [exec cp $errf $Home/TkzErr$MyPid-$tno]
            }
          set ErrArgs "$Home/TkzLst$MyPid-$tno $Home/TkzErr$MyPid-$tno $lstf $errf"
          $statw configure -bg black
          set $stat "Done"
          GErrMsgBox 91
          return -1
          }
        }
#----------------------------------
      }
    }
#------------
  }

$statw configure -fg black
set $stat "   Done   "
catch { [exec rm $lstf $errf $flist] }

cd $where
return $rc
}

#--------------------------------------------------------------
#  DelTar  --  Delete member(s) from a TAR
#
#--------------------------------------------------------------
proc DelTar {owner dirname arcname flist lstf errf} {
set thisproc "DelTar"
global TempDir TmpNo ErrArgs

set tno $TmpNo
set tmp "creating$owner"
global $tmp
set creating [set $tmp]
#set tmp "apn$owner"
#global $tmp
#set apn [set $tmp]
#set tmp "recurs$owner"
#global $tmp
#set recurs [set $tmp]
set tmp "ArcFno$owner"
global $tmp
set type [set $tmp]

set TheArcFile $dirname/$arcname
#  If compressed tar, there's a temp file to use...
set temptar "TmpTar$owner"
global $temptar
set temptarfile [set $temptar]
if {$temptarfile == ""}  {
  set thefile "$TheArcFile"
  }  else  {
  set thefile $temptarfile
  }

set xlist ""
if [ catch {set fl [open $flist r]} ]  {
  return -1
  }
#  Since tar delete is most likely to work from the end of the
#  archive, reverse the list to improve our chances...
while {[ gets $fl line ] > -1}  {
  set xlist "$line $xlist"
  }
catch [close $fl]

#  NOTE:  gotta check syntax for non-GNU tars...
foreach fn $xlist  {
  set rc [catch {exec tar --delete -f $thefile $fn >$lstf 2>$errf} cc]
  if {$rc != 0}  {
    break
    }
  }

if {$rc != 0}  {
  set ErrArgs "$lstf $errf $TheArcFile"
  GErrMsgBox 87
  return $rc
  }

#------------------
switch $type      {
    1          -
    5          -
    14          {
        if {$temptarfile == ""}  {
          set temptarfile "$TempDir/TkzTtar$tno"
          set $temptar $temptarfile
          }
        if {$thefile == $TheArcFile}  {
          set rc [ catch {exec cp $thefile $temptarfile}]
          }
        if [ catch {set fl [open $flist w]} ]  {
          return -1
          }
        puts $fl "$temptarfile"
        catch {[close $fl]}
        #  Play a little fast and loose with the calling args here...
        switch $type      {
            1      {
               set rc [AddGzp $owner $owner $dirname $arcname $flist $lstf $errf]
               }
            5      {
               set rc [AddCmp $owner $owner $dirname $arcname $flist $lstf $errf]
               }
            14     {
               set rc [AddBzip $owner $owner $dirname $arcname $flist $lstf $errf]
               }
            }

        return $rc
        }
    3          {
        }
    default    {
        return $rc
        }
    }
#------------------

return $rc
}

#--------------------------------------------------------------
#  AddTar  --  Add member(s) to a TAR
#
#    Options supported:
#        Absolute or relative pathnames  --  default: relative
#--------------------------------------------------------------
proc AddTar {parent owner dirname arcname flist lstf errf} {
set thisproc "AddTar"
global TempDir TmpNo ErrArgs

set tno $TmpNo
set tmp "creating$parent"
global $tmp
set creating [set $tmp]
set tmp "apn$owner"
global $tmp
set apn [set $tmp]
set tmp "jpn$owner"
global $tmp
set jpn [set $tmp]
#set tmp "recurs$owner"
#global $tmp
#set recurs [set $tmp]
set tmp "ArcFno$parent"
global $tmp
set type [set $tmp]

set TheArcFile $dirname/$arcname
#  If compressed and not new, there's a temp file to use...
set temptar "TmpTar$parent"
global $temptar
set temptarfile [set $temptar]
if {$temptarfile == ""}  {
  set thefile "$TheArcFile"
  }  else  {
  set thefile $temptarfile
#  Should not happen if creating...
  if {$creating}  {
    puts"$thisproc:      Found temp tar $temptarfile while creating. This *cannot* happen  --  how did it?"
    GErrMsgBox 99
    }
  }

set xlist ""
set where [pwd]

if [ catch {set fl [open $flist r]} ]  {
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

set flags ""
if {! $apn && ! $jpn}  {
  cd "/"
  }

foreach fn $xlist  {
  if {! $jpn}  {
    if {! $apn}  {
      set fn [string range $fn 1 end]
      set rc [catch {exec tar -rf $thefile $fn >$lstf 2>$errf} cc]
      }  else  {
      set rc [catch {exec tar -rPf $thefile $fn >$lstf 2>$errf} cc]
      }
    }  else  {
    #  Junking the pathname...absolute pathname is meaninless
    set l1 [string last "/" $fn]
    incr l1
    set fnn [string range $fn $l1 end]
    incr l1 -2
    set fnd [string range $fn 0 $l1]
    cd $fnd
    set rc [catch {exec tar -rf $thefile $fnn >$lstf 2>$errf} cc]
    }

#  if {! $apn}  {
#    set rc [catch {exec tar -rf $thefile $fn >$lstf 2>$errf} cc]
#    }  else  {
#    set rc [catch {exec tar -rPf $thefile $fn >$lstf 2>$errf} cc]
#    }


  if {$rc != 0}  {
    break
    }
  }

cd $where
if {$rc != 0}  {
  set ErrArgs "$lstf $errf $TheArcFile"
  GErrMsgBox 88
  return $rc
  }

switch $type      {
    1          -
    5          -
    14          {
        if {$temptarfile == ""}  {
          set temptarfile "$TempDir/TkzTtar$tno"
          set $temptar $temptarfile
          }
        if {$thefile == $TheArcFile}  {
          set rc [ catch {exec cp -f $thefile $temptarfile}]
          }
        if [ catch {set fl [open $flist w]} ]  {
          return -1
          }
        puts $fl "$temptarfile"
        catch {[close $fl]}
        switch $type      {
            1      {
               set rc [AddGzp $parent $owner $dirname $arcname $flist $lstf $errf]
               }
            5      {
               set rc [AddCmp $parent $owner $dirname $arcname $flist $lstf $errf]
               }
            14     {
               set rc [AddBzip $parent $owner $dirname $arcname $flist $lstf $errf]
               }
            }

        return $rc
        }
    3          {
        }
    default    {
        return $rc
        }
    }


return $rc
}



#--------------------------------------------------------------
#  The Gzip Handling Routines --  Handle Gzip files
#    - with new structure, if unzipped file is a tar,
#      we'll just untar it
#
#--------------------------------------------------------------

#---------------------------------------------------------------
#  GetDirGzp  --  Get the Archive Directory list data for a GZIP
#
#---------------------------------------------------------------
proc GetDirGzp {owner dirname arcname dummyname errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg 
global TmpNo TempDir Home MyPid ErrArgs Desperation NoProbe

set thisproc "GetDirGzp"
set thiswin $owner
set WinName ".$owner"
set topf "$WinName.top"
set archdr "$WinName.hdr"
set arcbody "$WinName.body"
set fv "ArcFno$thiswin"
global $fv
set ArcFno [set $fv]
set WButBg [lindex $TButBg $ArcFno]
# incr TmpNo
set tno $TmpNo
set tmpf "$TempDir/TkzTmp$tno"
#set errf "$TempDir/TkzErr$tno"
set temptar "TmpTar$owner"
global $temptar
set temptarname "TkzTtar$tno"
set temptarfile "$TempDir/TkzTtar$tno"
set $temptar $temptarfile

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]

set ap "ArcPgm$thiswin"
set lf "ListFlags$thiswin"
global $ap $lf
set arcpgm [set $ap]
set listflags [set $lf]

# set arcpgm "gunzip"
# set listflags "-l"


#--------------------
# Now read the list...
set where [pwd]
#  This is speshul...if we use the full pathname, that's what gunzip will
#  show in the listing, which we don't want.
cd $dirname
set TheArcFile $arcname
if { $dirname == "/dev" && [string first "n" $arcname] == 0 }  {
  cd $TempDir
  set tmp [string last "/" $tmparc]
  incr tmp
  set TheArcFile [string range $tmparc $tmp end]
  }
	set rc [ catch { set in [ open [ concat "|gunzip -l $TheArcFile 2>>$errf" ] r ] } cc]
	if {$rc != 0}  {
          #  The caller needs to take the appropriate action here...
          #  just tell him nfg...
	  return -1
	  }

        set dfltwidth 80
        set hdrwidth 0
        set hdrflds 4
        set llen 0
        set ll1 0
        set fl1 0
	set lineno 0
	set ignline 1
	set startdata 0
	# Heading for gzip...
	label $archdr.h1 -relief groove
	label $archdr.h2 -relief groove
	label $archdr.h3 -relief groove
	label $archdr.h4 -relief groove
	# End gzip heading...
        while  { [ gets $in line ] > -1 } {
          incr lineno
          if {$lineno == 1}  {
            set startdata 1
            # etc
	    $archdr.h1 configure -bg $WButBg -highlightbackground $WButBg -text [ lindex $line 0 ]
	    $archdr.h2 configure -bg $WButBg -highlightbackground $WButBg -text " [ lindex $line 1 ]" 
	    $archdr.h3 configure -bg $WButBg -highlightbackground $WButBg -text " [ lindex $line 2 ]   " 
            $archdr.h4 configure -bg $WButBg -highlightbackground $WButBg -text [ lindex $line 3 ] 
#	    pack $archdr.h1 $archdr.h2 $archdr.h3 -side left  
#	    pack $archdr.h$hdrflds -anchor w -side left -fill x -expand yes
            }
          if {! $ignline}  {
#            set stripl [string length $dirname]
#            incr stripl
#            set line [string range $line $stripl end]
            $arcbody.alist insert end $line
            }
          if {$startdata}  {
            set ignline 0
            }
          }
        catch { close $in }
#  We've only just begun....
if {$lineno > 2}  {
  #  If this ever happens, something really strange is going on...
  #  just send back a formatted list & let the user figure it out.

  pack $archdr.h1 $archdr.h2 $archdr.h3 -side left  
  pack $archdr.h$hdrflds -anchor w -side left -fill x -expand yes
  scrollbar $arcbody.scrollx -orient horizontal -command "$arcbody.alist xview"
  $arcbody.alist configure -xscroll "$arcbody.scrollx set"
  pack $arcbody.scrollx -fill x -side bottom
  pack $arcbody.alist  -side left -fill both -expand yes
  cd $where
  return 1
  }

set rc 0
set ItsaTar 0
if {! $NoProbe}  {
#  OK, now to see if what's inside is a tar...
#  Gunzip says nasty things about a raw device here...  what to do, what to do?

  if {$dirname != "/dev"}  {
    set RawDev 0
    set rc [ catch { exec gunzip -c $TheArcFile >$temptarfile 2>$errf } cc]
    }  else  {
    #  This is unacceptably slow, but I dont't know what else to do...
    #  gunzip sometimes complains when reading directly from a device.
    set RawDev 1
    set rc [ catch { exec cat $TheArcFile | gunzip -c >$temptarfile 2>$errf } cc]
    }


  set trc [catch {set dummy [exec file $temptarfile ]} cc]
  if { [string first " tar " $cc] != -1 }  {
    set ItsaTar 1
    }  else  {
    if {$Desperation}  {
      #  Kluge time...ask tar if it's a tar.
      set trc [catch {set dummy [exec tar -tvf $temptarfile ]} cc]
      if {$rc == 0 && $cc != "" && [string first "oesn't" $cc] < 0 && [string first "kipping to" $cc] < 0 && [string first "nly read" $cc] < 0 && [string first "unknown file" $cc] < 0 }  {
        set ItsaTar 1
        }
      }
    }
  #  End  tar probe
  }

  if {$ItsaTar}  {
    #  Call it a tar, and destroy all the widgets the tar func will try to build...
    set ArcFno 1
    set $fv $ArcFno
    set arctype [SetArcVars $owner $ArcFno]
    set arctitle "$arctype:  $arcname"
    wm title $WinName $arctitle
    $arcbody.alist delete 0
    destroy $archdr.h1
    destroy $archdr.h2
    destroy $archdr.h3
    destroy $archdr.h4

    set trc [GetDirTar $owner $dirname $arcname $temptarfile $errf]
    if {$rc != 0} {
      return -4
      }
    return $trc
    }


pack $archdr.h1 $archdr.h2 $archdr.h3 -side left  
pack $archdr.h$hdrflds -anchor w -side left -fill x -expand yes

#  Now, what about error checking and window size configure...?
#  Well, only Zip needs some special checking at this point.

#  Window size - may need xscrollbar...
        if {$hdrwidth > $dfltwidth}  {
          set dfltwidth $hdrwidth
          }
#	if { $llen > $dfltwidth } {
#	  set ll1 $llen
#	  set llen $dfltwidth
          scrollbar $arcbody.scrollx -orient horizontal -command "$arcbody.alist xview"
          $arcbody.alist configure -xscroll "$arcbody.scrollx set"
#	  }

#        $arcbody.alist configure -width $llen
#        if { $ll1 > $llen } {
	  pack $arcbody.scrollx -fill x -side bottom
#	  } 
#  Do we want to do this here...?
        pack $arcbody.alist  -side left -fill both -expand yes

cd $where
#--------------------

if {$rc != 0}  {
  return -4
  }

return 1
}

#--------------------------------------------------------------
#  GetVGzp  --  Get a member to view from a GZIP
#
#--------------------------------------------------------------
proc GetVGzp {owner dirname arcname flist tmpd errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir
set thisproc "GetVGzp"
set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" && [string first "n" $arcname] == 0 }  {
  set tmp [string last "/" $tmparc]
  incr tmp
  set TheArcFile [string range $tmparc $tmp end]
  }

#  Extract to stdout as tmp file...
#set where [pwd]
#cd $TempDir
#set rc [ catch { exec gunzip -c $TheArcFile >$tmpf 2>$errf } cc]
#cd $where
##set crc [catch {exec cp $TempDir/$fname $tmpf} cc]
##catch [exec rm $TempDir/$fname]
set errc 0
set where [pwd]
set xlist ""
if [ catch {set fl [open $flist r]} ]  {
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

cd $tmpd
foreach fn $xlist  {
  set tmpf "$tmpd/$fn"
  set rc [ catch { exec gunzip -c $TheArcFile >$tmpf 2>$errf } cc]
  if {$rc > 0}  {
    set rc 0
    }
  }

cd $where
return $rc
}

#--------------------------------------------------------------
#  ExtGzp  --  Extract member(s) from a GZIP
#
#--------------------------------------------------------------
proc ExtGzp {owner dirname arcname whereto fname flist lstf errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir
set thisproc "ExtGzp"
set statw ".$owner.top.vopt.stat"
set stat "Stat$owner"
global $stat
set $stat "          "
$statw configure -textvariable $stat -fg red
set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" && [string first "n" $arcname] == 0 }  {
  set tmp [string last "/" $tmparc]
  incr tmp
  set TheArcFile [string range $tmparc $tmp end]
  }

#  Just go to the target dir and extract...
#  Pay no attention to flist, there's only one file to extract...
set where [pwd]
cd $whereto
set $stat "Extracting"
$statw configure -fg red
update idletasks
set rc [ catch { exec gunzip -c $TheArcFile >$fname 2>$errf } cc]

$statw configure -fg black
set $stat "   Done   "
catch { [exec rm $lstf $errf $flist] }

cd $where
return $rc
}

#--------------------------------------------------------------
#  AddGzp  --  "Add" to a Gzipped File
#    For consistency of program structure, this is called the 
#    Add function. It really amounts to the Compress function.
#    It gets a filelist with one member.
#
#    Options supported:
#        None at present...  Later, speed-vs-compression, and
#        replace-on-compress
#--------------------------------------------------------------
proc AddGzp {parent owner dirname arcname flist lstf errf} {
set thisproc "AddGzp"
global ErrArgs CompOpt

#set tmp "creating$parent"
#global $tmp
#set creating [set $tmp]
#set tmp "apn$owner"
#global $tmp
#set apn [set $tmp]
#set tmp "recurs$owner"
#global $tmp
#set recurs [set $tmp]
set tmp "ArcFno$parent"
global $tmp
set type [set $tmp]
set rc 0
set TheArcFile $dirname/$arcname
set xlist ""

if [ catch {set fl [open $flist r]} ]  {
#  puts "$thisproc:    open failure"
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

set flags ""
set flags "-c"
if {$CompOpt != 0}  {
  set flags "$flags -$CompOpt"
  }
foreach fn $xlist  {
  set cmd "exec gzip $flags $fn >$TheArcFile 2>$errf"
  set rc [catch {set rc [eval $cmd]} cc]
  if {$rc != 0}  {
    break
    }
  }
#  Temp...put up a message box here...
if {$rc != 0}  {
  set ErrArgs "$lstf $errf $TheArcFile"
  GErrMsgBox 89
  return $rc
  }

return $rc
}



#--------------------------------------------------------------
#  The Compress Handling Routines --  Handle Compressed files
#    - with new structure, if uncompressed file is a tar,
#      we'll just untar it
#
#--------------------------------------------------------------

#--------------------------------------------------------------------------
#  GetDirCmp  --  Get the Archive Directory list data for a Compressed file
#
#--------------------------------------------------------------------------
proc GetDirCmp {owner dirname arcname dummyname errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg 
global TmpNo TempDir GotZcat Desperation NoProbe

set thisproc "GetDirCmp"
set thiswin $owner
set WinName ".$owner"
set topf "$WinName.top"
set archdr "$WinName.hdr"
set arcbody "$WinName.body"
set fv "ArcFno$thiswin"
global $fv
set ArcFno [set $fv]
set WButBg [lindex $TButBg $ArcFno]
# incr TmpNo
set tno $TmpNo
set tmpf "$TempDir/TkzTmp$tno"
#set errf "$TempDir/TkzErr$tno"
set temptar "TmpTar$owner"
global $temptar
set temptarname "TkzTtar$tno"
set temptarfile "$TempDir/TkzTtar$tno"
set $temptar $temptarfile

set ap "ArcPgm$thiswin"
set lf "ListFlags$thiswin"
global $ap $lf
set arcpgm [set $ap]
set listflags [set $lf]

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" && [string first "n" $arcname] == 0 }  {
#  set tmp [string last "/" $tmparc]
#  incr tmp
#  set TheArcFile [string range $tmparc $tmp end]
  set TheArcFile $tmparc
  }

# set arcpgm "zcat"
# set listflags "-l"
if {$GotZcat}  {
  set arcpgm "zcat"
  }  else  {
  set arcpgm "uncompress"
  }

#--------------------
# Now read the list...
set where [pwd]
cd $dirname
if {$arcpgm == "uncompress"}  {
  #  Uncompress is ugly - call a special func.
  set rc [GetDirCmp2 $owner $dirname $arcname $dummyname $errf]
  return $rc
  }
#	set rc [ catch { set in [ open [ concat "|$arcpgm -l $dirname/$arcname 2>$errf" ] r ] } cc]
	set rc [ catch { set in [ open [ concat "|$arcpgm -l $TheArcFile 2>$errf" ] r ] } cc]
	if {$rc != 0}  {
          #  The caller needs to take the appropriate action here...
          #  just tell him nfg...
	  return -1
	  }

        set dfltwidth 80
        set hdrwidth 0
        set hdrflds 4
        set llen 0
        set ll1 0
        set fl1 0
	set lineno 0
	set ignline 1
	set startdata 0
	# Heading for gzip...
	label $archdr.h1 -relief groove
	label $archdr.h2 -relief groove
	label $archdr.h3 -relief groove
	label $archdr.h4 -relief groove
	# End gzip heading...
        while  { [ gets $in line ] > -1 } {
          incr lineno
          if {$lineno == 1}  {
            set startdata 1
            # etc
	    $archdr.h1 configure -bg $WButBg -highlightbackground $WButBg -text [ lindex $line 0 ]
	    $archdr.h2 configure -bg $WButBg -highlightbackground $WButBg -text " [ lindex $line 1 ]" 
	    $archdr.h3 configure -bg $WButBg -highlightbackground $WButBg -text " [ lindex $line 2 ]   " 
            $archdr.h4 configure -bg $WButBg -highlightbackground $WButBg -text [ lindex $line 3 ] 
#	    pack $archdr.h1 $archdr.h2 $archdr.h3 -side left  
#	    pack $archdr.h$hdrflds -anchor w -side left -fill x -expand yes
            }
          if {! $ignline}  {

            set l1 [llength $line]
            incr l1 -1
            set sfn [lindex $line $l1]
            set l1 [string last $sfn $line]
            incr l1 -1
            set line [string range $line 0 $l1]
            set l1 [string last "/" $sfn]
	    if {$l1 != -1}  {
              incr l1
              set sfn [string range $sfn $l1 end]
	      }  else  {
	      }
             set line "$line$sfn"

#            set stripl [string length $dirname]
#            incr stripl
#            set line [string range $line $stripl end]


            $arcbody.alist insert end $line
            }
          if {$startdata}  {
            set ignline 0
            }
          }
        catch { close $in }

#  We've only just begun....
if {$lineno > 2}  {
  #  If this ever happens, we've stumbled upon serious strangeness...
  #  just send back a formatted list & let the user figure it out.

  pack $archdr.h1 $archdr.h2 $archdr.h3 -side left  
  pack $archdr.h$hdrflds -anchor w -side left -fill x -expand yes
  scrollbar $arcbody.scrollx -orient horizontal -command "$arcbody.alist xview"
  $arcbody.alist configure -xscroll "$arcbody.scrollx set"
  pack $arcbody.scrollx -fill x -side bottom
  pack $arcbody.alist  -side left -fill both -expand yes
  cd $where
  return 1
  }

set rc 0
set ItsaTar 0
if {! $NoProbe}  {
#  OK, now to see if what's inside is a tar...

  if {$dirname != "/dev"}  {
    set RawDev 0
    set rc [ catch { exec $arcpgm -c $TheArcFile >$temptarfile 2>$errf } cc]
    }  else  {
    #  This is unacceptably slow, but I dont't know what else to do...
    set RawDev 1
    set rc [ catch { exec cat $TheArcFile | $arcpgm -c >$temptarfile 2>$errf } cc]
    }

  set trc [catch {set dummy [exec file $temptarfile ]} cc]
  if { [string first " tar " $cc] != -1 }  {
    set ItsaTar 1
    }  else  {
    if {$Desperation}  {
      #  Kluge time...ask tar if it's a tar.
      set trc [catch {set dummy [exec tar -tvf $temptarfile ]} cc]
      if {$rc == 0 && $cc != "" && [string first "oesn't" $cc] < 0 && [string first "kipping to" $cc] < 0 && [string first "nly read" $cc] < 0 && [string first "unknown file" $cc] < 0 }  {
        set ItsaTar 1
        }
      }
    }
  #  End  tar probe
  }

  if {$ItsaTar}  {
    #  Call it a tar, and destroy all the widgets the tar func will try to build...
    set ArcFno 5
    set $fv $ArcFno
    set arctype [SetArcVars $owner $ArcFno]
    set arctitle "$arctype:  $arcname"
    wm title $WinName $arctitle
    $arcbody.alist delete 0
    destroy $archdr.h1
    destroy $archdr.h2
    destroy $archdr.h3
    destroy $archdr.h4

    set trc [GetDirTar $owner $dirname $arcname $temptarfile $errf]
    if {$rc != 0} {
      return -4
      }
    return $trc
    }


pack $archdr.h1 $archdr.h2 $archdr.h3 -side left  
pack $archdr.h$hdrflds -anchor w -side left -fill x -expand yes

#  Now, what about error checking and window size configure...?
#  Well, only Zip needs some special checking at this point.

#  Window size - may need xscrollbar...
        if {$hdrwidth > $dfltwidth}  {
          set dfltwidth $hdrwidth
          }
#	if { $llen > $dfltwidth } {
#	  set ll1 $llen
#	  set llen $dfltwidth
          scrollbar $arcbody.scrollx -orient horizontal -command "$arcbody.alist xview"
          $arcbody.alist configure -xscroll "$arcbody.scrollx set"
#	  }

#        $arcbody.alist configure -width $llen
#        if { $ll1 > $llen } {
	  pack $arcbody.scrollx -fill x -side bottom
#	  } 
#  Do we want to do this here...?
        pack $arcbody.alist  -side left -fill both -expand yes

cd $where
#--------------------

if {$rc != 0}  {
  return -4
  }

return 1
}

#--------------------------------------------------------------------------
#  GetDirCmp2  --  called from GetDirCmp if we can't use zcat...
#
#--------------------------------------------------------------------------
proc GetDirCmp2 {owner dirname arcname dummyname errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg 
global TmpNo TempDir GotZcat Desperation NoProbe

set thisproc "GetDirCmp2"
set thiswin $owner
set WinName ".$owner"
set topf "$WinName.top"
set archdr "$WinName.hdr"
set arcbody "$WinName.body"
set fv "ArcFno$thiswin"
global $fv
set ArcFno [set $fv]
set WButBg [lindex $TButBg $ArcFno]
# incr TmpNo
set tno $TmpNo
set tmpf "$TempDir/TkzTmp$tno"
#set errf "$TempDir/TkzErr$tno"
set temptar "TmpTar$owner"
global $temptar
set temptarname "TkzTtar$tno"
set temptarfile "$TempDir/TkzTtar$tno"
set $temptar $temptarfile

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" && [string first "n" $arcname] == 0 }  {
#  set tmp [string last "/" $tmparc]
#  incr tmp
#  set TheArcFile [string range $tmparc $tmp end]
  set TheArcFile $tmparc
  }

set ap "ArcPgm$thiswin"
set lf "ListFlags$thiswin"
global $ap $lf
set arcpgm [set $ap]
set listflags [set $lf]

set arcpgm "uncompress"
# set listflags "-l"

#--------------------
# Now pretend to read the list...
set where [pwd]
# cd $dirname
  #  This is really crappy...uncompress doesn't tell you anything, so
  #  make something up.
set hdrflds 2
set tmp [string length $arcname]
incr tmp -2
if { [string range $arcname $tmp end] == ".z" || [string range $arcname $tmp end] == ".Z" }  {
  incr tmp -1
  set line [string range $arcname 0 $tmp]
  }  else  {
  set line $arcname
  }


label $archdr.h1 -relief groove
$archdr.h1 configure -bg $WButBg -highlightbackground $WButBg -text "              Name              "
  #  In fact, we should be sarcastic about it...
label $archdr.h2 -relief groove
$archdr.h2 configure -bg $WButBg -highlightbackground $WButBg \
  -text "(You really should install Gnu tar-zcat-gzip)"
$arcbody.alist insert end $line


set rc 0
set ItsaTar 0
if {! $NoProbe}  {
#  We've only just begun....
#  OK, now to see if what's inside is a tar...
#  Treat this the same way we do for gunzip...
  if {$dirname != "/dev"}  {
    set RawDev 0
    set rc [ catch { exec $arcpgm -c $TheArcFile >$temptarfile 2>$errf } cc]
    }  else  {
    #  This is unacceptably slow, but I dont't know what else to do...
    set RawDev 1
    set rc [ catch { exec cat $TheArcFile | $arcpgm -c >$temptarfile 2>$errf } cc]
    }

  set trc [catch {set dummy [exec file $temptarfile ]} cc]
  if { [string first " tar " $cc] != -1 }  {
    set ItsaTar 1
    }  else  {
    if {$Desperation}  {
      #  Kluge time...ask tar if it's a tar.
      set trc [catch {set dummy [exec tar -tvf $temptarfile ]} cc]
      if {$rc == 0 && $cc != "" && [string first "oesn't" $cc] < 0 && [string first "kipping to" $cc] < 0 && [string first "nly read" $cc] < 0 && [string first "unknown file" $cc] < 0 }  {
        set ItsaTar 1
        }
      }
    }
  #  End  tar probe
  }

  if {$ItsaTar}  {
    #  Call it a tar, and destroy all the widgets the tar func will try to build...
    set ArcFno 5
    set $fv $ArcFno
    set arctype [SetArcVars $owner $ArcFno]
    set arctitle "$arctype:  $arcname"
    wm title $WinName $arctitle
    $arcbody.alist delete 0
    destroy $archdr.h1
    destroy $archdr.h$hdrflds

    set trc [GetDirTar $owner $dirname $arcname $temptarfile $errf]
    if {$rc != 0} {
      return -4
      }
    return $trc
    }


pack $archdr.h1 -side left  
pack $archdr.h$hdrflds -anchor w -side left -fill x -expand yes

#  Now, what about error checking and window size configure...?
#  Well, only Zip needs some special checking at this point.

#  Window size - may need xscrollbar...
#        if {$hdrwidth > $dfltwidth}  {
#          set dfltwidth $hdrwidth
#          }
#	if { $llen > $dfltwidth } {
#	  set ll1 $llen
#	  set llen $dfltwidth
          scrollbar $arcbody.scrollx -orient horizontal -command "$arcbody.alist xview"
          $arcbody.alist configure -xscroll "$arcbody.scrollx set"
#	  }

#        $arcbody.alist configure -width $llen
#        if { $ll1 > $llen } {
	  pack $arcbody.scrollx -fill x -side bottom
#	  } 
#  Do we want to do this here...?
        pack $arcbody.alist  -side left -fill both -expand yes

# cd $where
#--------------------

if {$rc != 0}  {
  return -4
  }

return 1
}

#--------------------------------------------------------------
#  GetVCmp  --  Get a member to view from a Compressed file
#
#--------------------------------------------------------------
proc GetVCmp {owner dirname arcname flist tmpd errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir
set thisproc "GetVCmp"

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" && [string first "n" $arcname] == 0 }  {
#  set tmp [string last "/" $tmparc]
#  incr tmp
#  set TheArcFile [string range $tmparc $tmp end]
  set TheArcFile $tmparc
  }

#  Extract to stdout as tmp file...
#set where [pwd]
#cd $TempDir
#set rc [ catch { exec zcat -c $TheArcFile >$tmpf 2>$errf } cc]
#cd $where
##set crc [catch {exec cp $TempDir/$fname $tmpf} cc]
##catch [exec rm $TempDir/$fname]
#if {$rc > 0}  {
#  set rc 0
#  }
set errc 0
set where [pwd]
set xlist ""
if [ catch {set fl [open $flist r]} ]  {
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

cd $tmpd
foreach fn $xlist  {
  set l1 [string last "/" $fn]
    if {$l1 != -1}  {
      incr l1
      set sfn [string range $fn $l1 end]
      }  else  {
      set sfn $fn
      }
#  set tmpf "$tmpd$fn"

  set rc [ catch { exec zcat -c $TheArcFile >$sfn 2>$errf } cc]
  if {$rc > 0}  {
    set rc 0
    }
  }

cd $where
return $rc
}

#--------------------------------------------------------------
#  ExtCmp  --  Extract member(s) from a Compressed file
#
#--------------------------------------------------------------
proc ExtCmp {owner dirname arcname whereto fname flist lstf errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir
set thisproc "ExtCmp"
set statw ".$owner.top.vopt.stat"
set stat "Stat$owner"
global $stat
set $stat "          "
$statw configure -textvariable $stat -fg red

set ap "ArcPgm$owner"
global $ap
set arcpgm [set $ap]
set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" && [string first "n" $arcname] == 0 }  {
#  set tmp [string last "/" $tmparc]
#  incr tmp
#  set TheArcFile [string range $tmparc $tmp end]
  set TheArcFile $tmparc
  }

#  Just go to the target dir and extract...
#  Pay no attention to flist, there's only one file to extract...
set where [pwd]
cd $whereto
set $stat "Extracting"
$statw configure -fg red
update idletasks
#set tmp [string last "/" $fname]
#incr tmp
#set fn [string range $fname $tmp end]
set rc [ catch { exec $arcpgm -c $TheArcFile >$fname 2>$errf } cc]

$statw configure -fg black
set $stat "   Done   "
catch { [exec rm $lstf $errf $flist] }

cd $where
return $rc
}

#--------------------------------------------------------------
#  AddCmp  --  "Add" to a Compressed File
#    Called Add for consistency, it's really just Compress.
#    It gets a filelist with one member.
#
#    Options supported:
#        None at present...  
#--------------------------------------------------------------
proc AddCmp {parent owner dirname arcname flist lstf errf} {
set thisproc "AddCmp"
global ErrArgs CompOpt

#set tmp "creating$parent"
#global $tmp
#set creating [set $tmp]
#set tmp "apn$owner"
#global $tmp
#set apn [set $tmp]
#set tmp "recurs$owner"
#global $tmp
#set recurs [set $tmp]
set tmp "ArcFno$parent"
global $tmp
set type [set $tmp]
set rc 0
set TheArcFile $dirname/$arcname
set xlist ""

set where [pwd]
if [ catch {set fl [open $flist r]} ]  {
  puts "$thisproc:    open failure"
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

set flags ""
if {$CompOpt != 0}  {
  set flags "-c -b"
  switch $CompOpt    {
      1        {
          set flags "$flags 10"
          }
      6        {
          set flags "$flags 13"
          }
      9        {
          set flags "$flags 16"
          }
      }
  }  else  {
  set flags "-c"
  }

foreach fn $xlist  {
  set l1 [string last "/" $fn]
  if {$l1 != -1}  {
      incr l1
      set sfn [string range $fn $l1 end]
      incr l1 -2
      set sdn [string range $fn 0 $l1]
      }  else  {
      set sfn $fn
      set sdn ""
      }

  if {$sdn != ""}  {
    cd $sdn
    }
  set cmd "exec compress $flags $sfn >$TheArcFile 2>$errf"
  set rc [catch {set rc [eval $cmd]} cc]
  if {$rc != 0}  {
    break
    }
  }

cd $where
if {$rc != 0}  {
  set ErrArgs "$lstf $errf $TheArcFile"
  GErrMsgBox 89
  return $rc
  }

return $rc
}



#--------------------------------------------------------------
#  The Bzip Handling Routines --  Handle Bzipped files
#    - this program works just like the classic compress,
#      it's not particularly informative (no feature bloat here!)
#
#--------------------------------------------------------------

#--------------------------------------------------------------------------
#  GetDirBzip  --  Get the Archive Directory list data for a Bzip file
#
#--------------------------------------------------------------------------
proc GetDirBzip {owner dirname arcname dummyname errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg 
global TmpNo TempDir GotBzip Desperation NoProbe

set thisproc "GetDirBzip"
set thiswin $owner
set WinName ".$owner"
set topf "$WinName.top"
set archdr "$WinName.hdr"
set arcbody "$WinName.body"
set fv "ArcFno$thiswin"
global $fv
set ArcFno [set $fv]
set WButBg [lindex $TButBg $ArcFno]
# incr TmpNo
set tno $TmpNo
set tmpf "$TempDir/TkzTmp$tno"
#set errf "$TempDir/TkzErr$tno"
set temptar "TmpTar$owner"
global $temptar
set temptarname "TkzTtar$tno"
set temptarfile "$TempDir/TkzTtar$tno"
set $temptar $temptarfile
set tempbz "TmpBz$owner"
global $tempbz
set tempbzfile "$TempDir/Tbz$tno.bz"
set $tempbz $tempbzfile

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" && [string first "n" $arcname] == 0 }  {
#  set tmp [string last "/" $tmparc]
#  incr tmp
#  set TheArcFile [string range $tmparc $tmp end]
  set TheArcFile $tmparc
  }

set ap "ArcPgm$thiswin"
set lf "ListFlags$thiswin"
global $ap $lf
set arcpgm [set $ap]
set listflags [set $lf]

set arcpgm "bunzip"
# set listflags "-l"

#--------------------
# Now pretend to read the list...
set where [pwd]
# cd $dirname
  #  This is really crappy...bzip doesn't tell you any more than uncompress, so
  #  make something up.
set hdrflds 2
set tmp [string length $arcname]
incr tmp -3
if { [string range $arcname $tmp end] == ".bz"}  {
  incr tmp -1
  set line [string range $arcname 0 $tmp]
  }  else  {
  set line $arcname
  }

label $archdr.h1 -relief groove
$archdr.h1 configure -bg $WButBg -highlightbackground $WButBg -text "              Name              "
  #  In fact, we should be sarcastic about it...
label $archdr.h2 -relief groove
$archdr.h2 configure -bg $WButBg -highlightbackground $WButBg \
  -text "(This space intentionally left)"
$arcbody.alist insert end $line

set rc 0
set ItsaTar 0
if {! $NoProbe}  {
#  We've only just begun....
#  OK, now to see if what's inside is a tar...
#  Treat this the same way we do for gunzip, sort of...
#  Bzip probably won't even read from a device...but the name changing
#  gyrations below should take care of that.
  #  Bzip is really anal, it insists that the filename end in ".bz"...
  #  So if it doesn't, make it so.
  set tmp [string length $arcname]
  incr tmp -3
  set tmp2 [string last ".bz" $arcname]
  if {$tmp != $tmp2}  {
    set rc [ catch { exec cp $TheArcFile $tempbzfile } cc ]
    set rc [ catch { exec $arcpgm -c $tempbzfile >$temptarfile 2>$errf } cc]
# puts "$thisproc:  What's wrong with $TheArcFile - $tempbzfile - $cc"
    }  else  {
    set $tempbz ""
    set rc [ catch { exec $arcpgm -c $TheArcFile >$temptarfile 2>$errf } cc]
    }
  #  In case we misidentified this as a bzip, check for the error now, not later.
  #  This pgm doesn't set an error code or anything - gotta read the stderr file...
  set erc [ catch { exec cat $errf } cc]
  if { [string first "not a BZIP" $cc] != -1 || [string first "skipping" $cc] != -1}  {
    return -1
    }

  set trc [catch {set dummy [exec file $temptarfile ]} cc]
  if { [string first " tar " $cc] != -1 }  {
    set ItsaTar 1
    }  else  {
    if {$Desperation}  {
      #  Kluge time...ask tar if it's a tar.
      set trc [catch {set dummy [exec tar -tvf $temptarfile ]} cc]
      if {$rc == 0 && $cc != "" && [string first "oesn't" $cc] < 0 && [string first "kipping to" $cc] < 0 && [string first "nly read" $cc] < 0 && [string first "unknown file" $cc] < 0 }  {
        set ItsaTar 1
        }
      }
    }
  #  End  tar probe
  }

  if {$ItsaTar}  {
    #  Call it a tar, and destroy all the widgets the tar func will try to build...

    set ArcFno 14
    set $fv $ArcFno
    set arctype [SetArcVars $owner $ArcFno]
    set arctitle "$arctype:  $arcname"
    wm title $WinName $arctitle
    $arcbody.alist delete 0
    destroy $archdr.h1
    destroy $archdr.h$hdrflds

    set trc [GetDirTar $owner $dirname $arcname $temptarfile $errf]
    if {$rc != 0} {
      return -4
      }
    return $trc
    }


pack $archdr.h1 -side left  
pack $archdr.h$hdrflds -anchor w -side left -fill x -expand yes

#  Now, what about error checking and window size configure...?
#  Well, only Zip needs some special checking at this point.

#  Window size - may need xscrollbar...
#        if {$hdrwidth > $dfltwidth}  {
#          set dfltwidth $hdrwidth
#          }
#	if { $llen > $dfltwidth } {
#	  set ll1 $llen
#	  set llen $dfltwidth
          scrollbar $arcbody.scrollx -orient horizontal -command "$arcbody.alist xview"
          $arcbody.alist configure -xscroll "$arcbody.scrollx set"
#	  }

#        $arcbody.alist configure -width $llen
#        if { $ll1 > $llen } {
	  pack $arcbody.scrollx -fill x -side bottom
#	  } 
#  Do we want to do this here...?
        pack $arcbody.alist  -side left -fill both -expand yes

# cd $where
#--------------------

if {$rc != 0}  {
  return -4
  }

return 1
}

#--------------------------------------------------------------
#  GetVBzip  --  Get a member to view from a Bzipped file
#
#--------------------------------------------------------------
proc GetVBzip {owner dirname arcname flist tmpd errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir
set thisproc "GetVBzip"
set tempbz "TmpBz$owner"
global $tempbz
set tempbzfile [set $tempbz]

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" && [string first "n" $arcname] == 0 }  {
#  set tmp [string last "/" $tmparc]
#  incr tmp
#  set TheArcFile [string range $tmparc $tmp end]
  set TheArcFile $tmparc
  }

#  Extract to stdout as tmp file...
set tmp [string length $arcname]
incr tmp -3
set tmp2 [string last ".bz" $arcname]
if {$tmp != $tmp2}  {
  set TheFile $tempbzfile
  }  else  {
  set TheFile $TheArcFile
  }

#set where [pwd]
#cd $TempDir
#set rc [ catch { exec bunzip -c $TheFile >$tmpf 2>$errf } cc]
#cd $where
##set crc [catch {exec cp $TempDir/$fname $tmpf} cc]
##catch [exec rm $TempDir/$fname]
#if {$rc > 0}  {
#  set rc 0
#  }
set errc 0
set where [pwd]
set xlist ""
if [ catch {set fl [open $flist r]} ]  {
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

cd $tmpd
foreach fn $xlist  {
  set tmpf "$tmpd/$fn"
  set rc [ catch { exec bunzip -c $TheFile >$tmpf 2>$errf } cc]
  if {$rc > 0}  {
    set rc 0
    }
  }

cd $where

return $rc
}

#--------------------------------------------------------------
#  ExtBzip  --  Extract member(s) from a Bzipped file
#
#--------------------------------------------------------------
proc ExtBzip {owner dirname arcname whereto fname flist lstf errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir
set thisproc "ExtBzip"
set tempbz "TmpBz$owner"
global $tempbz
set tempbzfile [set $tempbz]
set statw ".$owner.top.vopt.stat"
set stat "Stat$owner"
global $stat
set $stat "          "
$statw configure -textvariable $stat -fg red

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" && [string first "n" $arcname] == 0 }  {
#  set tmp [string last "/" $tmparc]
#  incr tmp
#  set TheArcFile [string range $tmparc $tmp end]
  set TheArcFile $tmparc
  }

#  Just go to the target dir and extract...
#  Pay no attention to flist, there's only one file to extract...
set where [pwd]
cd $whereto
set $stat "Extracting"
$statw configure -fg red
update idletasks
#set tmp [string last "/" $fname]
#incr tmp
#set fn [string range $fname $tmp end]
set tmp [string length $arcname]
incr tmp -3
set tmp2 [string last ".bz" $arcname]
if {$tmp != $tmp2}  {
  set TheFile $tempbzfile
  }  else  {
  set TheFile $TheArcFile
  }
set rc [ catch { exec bunzip -c $TheFile >$fname 2>$errf } cc]

$statw configure -fg black
set $stat "   Done   "
catch { [exec rm $lstf $errf $flist] }

cd $where
return $rc
}

#--------------------------------------------------------------
#  AddBzip  --  "Add" to a BZIP File
#    Called Add function for cinsistency, it's really just Compress.
#    It gets a filelist with one member.
#
#    Options supported:
#        None at present...  
#--------------------------------------------------------------
proc AddBzip {parent owner dirname arcname flist lstf errf} {
set thisproc "AddBzip"
global ErrARgs CompOpt

#set tmp "creating$parent"
#global $tmp
#set creating [set $tmp]
#set tmp "apn$owner"
#global $tmp
#set apn [set $tmp]
#set tmp "recurs$owner"
#global $tmp
#set recurs [set $tmp]
set tmp "ArcFno$parent"
global $tmp
set type [set $tmp]
set rc 0
set TheArcFile $dirname/$arcname
set xlist ""

if [ catch {set fl [open $flist r]} ]  {
#  puts "$thisproc:    open failure"
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

set flags ""
set flags "-c"
#  Set the compression blocksize (1-9).... Note - this
#  value will be stored in the 4th byte of the magic string.
if {$CompOpt != 0}  {
  set flags "$flags -$CompOpt"
  }
foreach fn $xlist  {
    set cmd "exec bzip $flags $fn >$TheArcFile 2>$errf"
    set rc [catch {set rc [eval $cmd]} cc]
  if {$rc != 0}  {
    break
    }
  }

if {$rc != 0}  {
  set ErrArgs "$lstf $errf $TheArcFile"
  GErrMsgBox 89
  return $rc
  }

return $rc
}



#-------------------------------------------------------------------
#  The LHarc Handling Routines --  Handle lha/lzh archives (type 15)
#    - 
#
#-------------------------------------------------------------------

#--------------------------------------------------------------------------
#  GetDirLha  --  Get the Archive Directory list data for an LHa archive
#
#--------------------------------------------------------------------------
proc GetDirLha {owner dirname arcname dummyname errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg 
global TmpNo TempDir GotBzip Desperation NoProbe

set thisproc "GetDirLha"
set thiswin $owner
set WinName ".$owner"
set topf "$WinName.top"
set archdr "$WinName.hdr"
set arcbody "$WinName.body"
set fv "ArcFno$thiswin"
global $fv
set ArcFno [set $fv]
set WButBg [lindex $TButBg $ArcFno]
# incr TmpNo
set tno $TmpNo
set tmpf "$TempDir/TkzTmp$tno"
# set errf "$TempDir/TkzErr$tno"

set ap "ArcPgm$thiswin"
set lf "ListFlags$thiswin"
global $ap $lf
set arcpgm [set $ap]
set listflags [set $lf]

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
#  Zip doesn't like to read from devices at all...
if { $dirname == "/dev" }  {
    set TheArcFile $tmparc
  }


# set arcpgm "lha"
# set listflags "v"
set rc 0

#--------------------
# Now read the list...
##--------------------

	set rc [ catch { set in [ open [ concat "|$arcpgm $listflags $TheArcFile 2>$errf" ] r ] } cc]
	if {$rc != 0}  {
          #  The caller needs to take the appropriate action here...
          #  just tell him nfg...
	  return -1
	  }

        set dfltwidth 80
        set hdrwidth 0
        set hdrflds 8
        set llen 0
        set ll1 0
        set fl1 0
#--------------------------
        set fl1 11
        set fl2 11
        set fl3 9
        set fl4 9
        set fl5 8
        set fl6 12
        set fl7 18
        set fl8 24
#--------------------------
	set lineno 0
	# Heading for lha...
	label $archdr.h1 -relief groove
	label $archdr.h2 -relief groove
	label $archdr.h3 -relief groove
	label $archdr.h4 -relief groove
	label $archdr.h5 -relief groove
	label $archdr.h6 -relief groove
	label $archdr.h7 -relief groove
	label $archdr.h8 -relief groove
	pack $archdr.h1 $archdr.h2 $archdr.h3 $archdr.h4 $archdr.h5 $archdr.h6 $archdr.h7 -side left  
	pack $archdr.h8 -anchor w -side left -fill x -expand yes
	$archdr.h1 configure -bg $WButBg -highlightbackground $WButBg -text "   Perm       "
	$archdr.h2 configure -bg $WButBg -highlightbackground $WButBg -text "  Owner/Grp  "
	$archdr.h3 configure -bg $WButBg -highlightbackground $WButBg -text "  Packed  " 
	$archdr.h4 configure -bg $WButBg -highlightbackground $WButBg -text "   Size   "
	$archdr.h5 configure -bg $WButBg -highlightbackground $WButBg -text " Ratio   "
	$archdr.h6 configure -bg $WButBg -highlightbackground $WButBg -text "      CRC     "
	$archdr.h7 configure -bg $WButBg -highlightbackground $WButBg -text "          Date              " 
	$archdr.h8 configure -bg $WButBg -highlightbackground $WButBg -text "           Name        "
	# End lha heading...
	set ignline 1
	
        while  { [ gets $in line ] > -1 } {
	  incr lineno
	  if {$ignline}  {
            if {[string first "--------" $line] == 0}  {
              set ignline 0
	      }
	    continue
	    }  else  {
            if {[string first "--------" $line] == 0}  {
              set ignline 1
              continue
              }
	    }
#-------------
          #  Adapt column widths to actual data found...
          set fc 0
          set ffc 0
          set fline ""
          while {$fc < $hdrflds}  {
            set fld [lindex $line $ffc]
            switch    $ffc    {
              0      -
              1      -
              2      -
              3      -
              4      {
                  set fl [string length [lindex $line $ffc]]
                  }
              5      {
                  set fl [string length [lindex $line $ffc]]
                  incr ffc
                  incr fl [string length [lindex $line $ffc]]
                  incr fl
                  set fld [string trim $fld]
                  set fldtmp [string trim [lindex $line $ffc]]
                  set fld "$fld $fldtmp"
                  }
              7      {
                  set date [lindex $line $ffc]
                  set name [lindex $line end]
                  set ds [string first $date $line]
                  set ns [string last $name $line]
                  incr ds -1
                  incr ns -1
                  set fld [string range $line $ds $ns]
                  set fl [string length $fld]
                  }
              }

            if {$fc == 7}  {
              set fld [lindex $line end]
              set fl [string length $fld]
              }
            incr fc
            incr ffc
            set fln "fl$fc"
            if {$fl > [set $fln]}  {
               set $fln $fl
               }
            set fld [string trim $fld]

            switch    $fc        {
                3          -
                4          -
                5          {
                    set fld [string trim $fld]
                    set fltmp [string length $fld]
                    set fltmp2 [set $fln]
                    set fltmp2 [expr $fltmp2 - $fltmp]
                    if {$fltmp2 > 0}  {
                      incr fltmp2 -1
                      set ftmp [string range "                " 0 $fltmp2]
                      set fld "$ftmp$fld"
                      }
                    }
                6          -
                8          {
                    set fld " $fld "
                    }
                default    {
                    set fld "$fld                "
                    set fltmp [set $fln]
                    incr fltmp -1
                    set fld [string range $fld 0 $fltmp]
                    }
                  }


            set fline "$fline$fld"
            }

          $arcbody.alist insert end $fline
          }
        catch { close $in }

##--------------------
# Done...
#--------------------
set llen 80
##  Window size - may need xscrollbar...
#        if {$hdrwidth > $dfltwidth}  {
#          set dfltwidth $hdrwidth
#          }
##	if { $llen > $dfltwidth } {
##	  set ll1 $llen
##	  set llen $dfltwidth
#          scrollbar $arcbody.scrollx -orient horizontal -command "$arcbody.alist xview"
#          $arcbody.alist configure -xscroll "$arcbody.scrollx set"
##	  }
#
        $arcbody.alist configure -width $llen
##        if { $ll1 > $llen } {
#	  pack $arcbody.scrollx -fill x -side bottom
##	  } 
#  Do we want to do this here...?
        pack $arcbody.alist  -side left -fill both -expand yes
##--------------------

return $rc
}

#--------------------------------------------------------------
#  GetVLha  --  Get a member to view from an LHa archive
#
#--------------------------------------------------------------
proc GetVLha {owner dirname arcname flist tmpd errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir
global ErrArgs
set thisproc "GetVLha"

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" }  {
#  set tmp [string last "/" $tmparc]
#  incr tmp
#  set TheArcFile [string range $tmparc $tmp end]
  set TheArcFile $tmparc
  }

#  This one should be simple, but -p to stdout tacks on a crappy heading, so...
#set where [pwd]
#cd $TempDir
#set l1 [string last "/" $fname]
#if {$l1 != -1}  {
#  incr l1
#  set fnn [string range $fname $l1 end]
#  }  else  {
#  set fnn $fname
#  }
#
#set rc [catch {exec lha -xi $TheArcFile $fname >$tmpf 2>$errf} cc]
#set here [pwd]
##puts "Trying to copy $fnn to $tmpf in $here"
#catch {[exec cp $fnn $tmpf]}
#catch {[exec rm -f $fnn]}
#------------------
set errc 0
set where [pwd]
set xlist ""
if [ catch {set fl [open $flist r]} ]  {
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

cd $tmpd
foreach fn $xlist  {
  set l1 [string last "/" $fn]
  if {$l1 != -1}  {
    incr l1
    set fnn [string range $fn $l1 end]
    }  else  {
    set fnn $fn
    }

    set tmpf "$tmpd/$fn"
    set rc [catch {exec lha -xi $TheArcFile $fn >>$errf 2>>$errf} cc]

    catch [exec cp $fn $tmpf]
  if {$rc != 0}  {
    cd $where
    return $rc
    }
  }
#------------------

cd $where
return $rc
}

#--------------------------------------------------------------
#  ExtLha  --  Extract member(s) from an LHa archive
#
#--------------------------------------------------------------
proc ExtLha {owner dirname arcname whereto fname flist lstf errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir
set thisproc "ExtLha"
set statw ".$owner.top.vopt.stat"
set stat "Stat$owner"
global $stat
set $stat "          "
set fv "ArcFno$owner"
global $fv
set ArcFno [set $fv]
if {$ArcFno == 2}  {
  set vred "red"
  }  else  {
  #  Because the background on that one is also red...
  #  so call this virtual red.
  set vred "green"
  }

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" }  {
  set TheArcFile $tmparc
  }
set tmp "sdirl$owner"
global $tmp
set flist3 [set $tmp]
set rc 0

$statw configure -textvariable $stat -fg $vred

#  Pay no attention to fname, we may have a lotta files to extract...
#  gotta access the list of member names to extract.
#  For each file in list, just extract in the target dir.
set $stat "Extracting"
$statw configure -fg $vred

update idletasks
set xlist ""
if [ catch {set fl [open $flist r]} ]  {
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

set where [pwd]
cd $whereto
foreach fn $xlist  {
  set rc [catch {exec lha -x $TheArcFile $fn >$lstf 2>$errf} cc]
  }
#------------
  if {! $rc && $flist3 != ""}  {
    foreach fn $flist3  {
      set rc [catch {exec lha -x $TheArcFile $fn >>$lstf 2>>$errf} cc]
      }
    }
#------------

$statw configure -fg black
set $stat "   Done   "
catch { [exec rm $lstf $errf $flist] }

cd $where
return $rc
}

#--------------------------------------------------------------
#  AddLha  --  Add member(s)to an LHa archive
#
#    Options supported:
#        Absolute or relative pathnames  --  default: relative
#        Loose or keep pathnames  --  default: keep pathnames
#--------------------------------------------------------------
proc AddLha {parent owner dirname arcname flist lstf errf} {
set thisproc "AddLha"
global ErrArgs


set tmp "creating$parent"
global $tmp
set creating [set $tmp]
set tmp "apn$owner"
global $tmp
set apn [set $tmp]
set tmp "jpn$owner"
global $tmp
set jpn [set $tmp]
#set tmp "recurs$owner"
#global $tmp
#set recurs [set $tmp]
set tmp "ArcFno$parent"
global $tmp
set type [set $tmp]
set rc 0
set TheArcFile $dirname/$arcname
set xlist ""
set where [pwd]

if [ catch {set fl [open $flist r]} ]  {
#  puts "$thisproc:    open failure"
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

set flags ""
if {! $apn && ! $jpn}  {
  cd "/"
  }

foreach fn $xlist  {
#    ****  gotta check what the options are...
  if {! $jpn}  {
    if {! $apn}  {
      set fn [string range $fn 1 end]
      }
set here [pwd]
    set rc [catch {exec lha -a $TheArcFile $fn >$lstf 2>$errf} cc]
    }  else  {
#  Junking the pathname...absolute pathname is meaninless
set l1 [string last "/" $fn]
incr l1
set fnn [string range $fn $l1 end]
incr l1 -2
set fnd [string range $fn 0 $l1]
cd $fnd
    set rc [catch {exec lha -a $TheArcFile $fnn >$lstf 2>$errf} cc]
    }

#  set rc [catch {exec lha -a $TheArcFile $fn >$lstf 2>$errf} cc]

  if {$rc != 0}  {
    break
    }
  }

cd $where
#  Put up an oops box here...
if {$rc != 0}  {
  set ErrArgs "$lstf $errf $TheArcFile"
  GErrMsgBox 88
  return $rc
  }

return $rc
}

#--------------------------------------------------------------
#  DelLha  --  Delete member(s) from an LHa archive
#
#    Options supported:
#        None at present...  
#--------------------------------------------------------------
proc DelLha {owner dirname arcname flist lstf errf} {
set thisproc "DelLha"
global ErrArgs

set TheArcFile $dirname/$arcname
set xlist ""
if [ catch {set fl [open $flist r]} ]  {
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

foreach fn $xlist  {
  set rc [catch {exec lha -d $TheArcFile $fn >$lstf 2>$errf} cc]
  if {$rc != 0}  {
    break
    }
  }

if {$rc != 0}  {
  set ErrArgs "$lstf $errf $TheArcFile"
  GErrMsgBox 87
  return $rc
  }

return $rc
}



#--------------------------------------------------------------
#  The Cpio Handling Routines --  Handle cpio archives (type 16)
#    - 
#
#--------------------------------------------------------------

#--------------------------------------------------------------------------
#  GetDirCpio  --  Get the Archive Directory list data for a cpio archive
#
#--------------------------------------------------------------------------
proc GetDirCpio {owner dirname arcname dummyname errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg 
global TmpNo TempDir GotBzip Desperation NoProbe

set thisproc "GetDirCpio"
set thiswin $owner
set WinName ".$owner"
set topf "$WinName.top"
set archdr "$WinName.hdr"
set arcbody "$WinName.body"
set fv "ArcFno$thiswin"
global $fv
set ArcFno [set $fv]
set WButBg [lindex $TButBg $ArcFno]
# incr TmpNo
set tno $TmpNo
set tmpf "$TempDir/TkzTmp$tno"
# set errf "$TempDir/TkzErr$tno"

set ap "ArcPgm$thiswin"
set lf "ListFlags$thiswin"
global $ap $lf
set arcpgm [set $ap]
set listflags [set $lf]

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
#  Zip doesn't like to read from devices at all...
if { $dirname == "/dev" }  {
    set TheArcFile $tmparc
  }


# set arcpgm "cpio"
# set listflags "-t"
set rc 0

#--------------------
# Now read the list...
##--------------------

	set rc [ catch { set in [ open [ concat "|$arcpgm $listflags <$TheArcFile 2>$errf" ] r ] } cc]
	if {$rc != 0}  {
          #  The caller needs to take the appropriate action here...
          #  just tell him nfg...
	  return -1
	  }
        set dfltwidth 80
        set hdrwidth 0
        set hdrflds 5
        set llen 0
        set ll1 0
        set fl1 0
#--------------------------
        set fl1 11
        set fl2 11
        set fl3 9
        set fl4 18
        set fl5 24
#--------------------------
	set lineno 0
	# Heading for cpio...
	label $archdr.h1 -relief groove
	label $archdr.h2 -relief groove
	label $archdr.h3 -relief groove
	label $archdr.h4 -relief groove
	label $archdr.h5 -relief groove
	pack $archdr.h1 $archdr.h2 $archdr.h3 $archdr.h4 -side left  
	pack $archdr.h5 -anchor w -side left -fill x -expand yes
	$archdr.h1 configure -bg $WButBg -highlightbackground $WButBg -text "   Perm       "
	$archdr.h2 configure -bg $WButBg -highlightbackground $WButBg -text "  Owner/Grp  "
	$archdr.h3 configure -bg $WButBg -highlightbackground $WButBg -text "  Size    " 
	$archdr.h4 configure -bg $WButBg -highlightbackground $WButBg -text "          Date             " 
	$archdr.h5 configure -bg $WButBg -highlightbackground $WButBg -text "           Name        "
	# End cpio heading...
        while  { [ gets $in line ] > -1 } {
	  incr lineno
#-------------
          #  Adapt column widths to actual data found...
          set fc 0
          set ffc 0
          set fline ""
          while {$fc < $hdrflds}  {
            set fld [lindex $line $ffc]
            switch    $ffc    {
              0      -
              4      {
                  set fl [string length [lindex $line $ffc]]
                  }
              1      {
                  incr ffc
                  continue
                  }
              2      {
                  set fl [string length [lindex $line $ffc]]
                  incr ffc
                  incr fl [string length [lindex $line $ffc]]
                  incr fl
                  set fld [string trim $fld]
                  set fldtmp [string trim [lindex $line $ffc]]
                  set fld "$fld/$fldtmp"
                  }
              5      {
                  set date [lindex $line $ffc]
                  set name [lindex $line end]
                  set ds [string first $date $line]
                  set ns [string last $name $line]
                  incr ds -1
                  incr ns -1
                  set fld [string range $line $ds $ns]
                  set fl [string length $fld]
                  }
              }

            if {$fc == 4}  {
              set fld [lindex $line end]
              set fl [string length $fld]
              }
            incr fc
            incr ffc
            set fln "fl$fc"
            if {$fl > [set $fln]}  {
               set $fln $fl
               }
            set fld [string trim $fld]

            switch    $fc        {
                3          -
                4          {
                    set fld [string trim $fld]
                    set fltmp [string length $fld]
                    set fltmp2 [set $fln]
                    set fltmp2 [expr $fltmp2 - $fltmp]
                    if {$fltmp2 > 0}  {
                      incr fltmp2 -1
                      set ftmp [string range "                " 0 $fltmp2]
                      set fld "$ftmp$fld"
                      }
                    }
                5          {
                    set fld " $fld"
                    }
                default    {
                    set fld "$fld                "
                    set fltmp [set $fln]
                    incr fltmp -1
                    set fld [string range $fld 0 $fltmp]
                    }
                  }


            set fline "$fline$fld"
            }

          $arcbody.alist insert end $fline
          }
        catch { close $in }

##--------------------
# Done...
#--------------------
set llen 80
##  Window size - may need xscrollbar...
#        if {$hdrwidth > $dfltwidth}  {
#          set dfltwidth $hdrwidth
#          }
##	if { $llen > $dfltwidth } {
##	  set ll1 $llen
##	  set llen $dfltwidth
          scrollbar $arcbody.scrollx -orient horizontal -command "$arcbody.alist xview"
          $arcbody.alist configure -xscroll "$arcbody.scrollx set"
##	  }
#
        $arcbody.alist configure -width $llen
##        if { $ll1 > $llen } {
	  pack $arcbody.scrollx -fill x -side bottom
##	  } 
#  Do we want to do this here...?
        pack $arcbody.alist  -side left -fill both -expand yes
##--------------------

return $rc
}

#--------------------------------------------------------------
#  GetVCpio  --  Get a member to view from a cpio archive
#
#--------------------------------------------------------------
proc GetVCpio {owner dirname arcname flist tmpd errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir
global ErrArgs
set thisproc "GetVCpio"

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" }  {
#  set tmp [string last "/" $tmparc]
#  incr tmp
#  set TheArcFile [string range $tmparc $tmp end]
  set TheArcFile $tmparc
  }

#  This is really grotesque...
#  Have to go to temp dir & extract it there - the whole damn path...
#  and if it has a leading "/" we have to refuse to do it, for obvious reasons.
#  Note - we should make Add refuse ever to use a leading "/"...
set errc 0
set where [pwd]
set xlist ""
if [ catch {set fl [open $flist r]} ]  {
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

cd $tmpd
foreach fn $xlist  {
  if {[string first "/" $fn] == 0}  {
    if {! $errc}  {
      set ErrArgs $fn
      GErrMsgBox 85
      set errrc 85
      }
      }
    }  else  {
    set tmpi [string last "/" $fn]
    set tmpf [string range $fn $tmpi end]
    set rc [catch {exec cpio -id -I $TheArcFile $fn  2>$errf} cc]
    if {$fn != $tmpf}  {
      set tmpf "$tmpd/$tmpf"
      catch [exec cp $fn $tmpf]
      set l1 [string first "/" $fn]
      if {$l1 != -1}  {
        incr l1 -1
        set fdir [string range $fn 0 $l1]
        catch [exec rm -rf $fdir]
        }  else  {
        catch [exec rm -f $fn]
        }
      }
  if {$rc != 0}  {
    cd $where
    return $rc
    }
  }
  cd $where

return $rc
}

#--------------------------------------------------------------
#  ExtCpio  --  Extract member(s) from a cpio archive
#
#--------------------------------------------------------------
proc ExtCpio {owner dirname arcname whereto fname flist lstf errf} {
global whohdr timehdr WhoBg MainButBg MainBg TBg TButBg TFg TmpNo TempDir
set thisproc "ExtCpio"
set statw ".$owner.top.vopt.stat"
set stat "Stat$owner"
global $stat
set $stat "          "
set fv "ArcFno$owner"
global $fv
set ArcFno [set $fv]
if {$ArcFno == 2}  {
  set vred "red"
  }  else  {
  #  Because the background on that one is also red...
  #  so call this virtual red.
  set vred "green"
  }

set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set TheArcFile $dirname/$arcname
if { $dirname == "/dev" }  {
  set TheArcFile $tmparc
  }
set tmp "sdirl$owner"
global $tmp
set flist3 [set $tmp]
set rc 0

$statw configure -textvariable $stat -fg $vred

#  Pay no attention to fname, we may have a lotta files to extract...
#  gotta access the list of member names to extract.
#  For each file in list, just extract in the target dir.
set $stat "Extracting"
$statw configure -fg $vred

update idletasks
set xlist ""
if [ catch {set fl [open $flist r]} ]  {
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

set where [pwd]
cd $whereto
foreach fn $xlist  {
  set rc [catch {exec cpio -id -I $TheArcFile $fn >$lstf 2>$errf} cc]
  }
#------------
  if {! $rc && $flist3 != ""}  {
    foreach fn $flist3  {
      set rc [catch {exec cpio -id -I $TheArcFile $fn >>$lstf 2>>$errf} cc]
      }
    }
#------------

$statw configure -fg black
set $stat "   Done   "
catch { [exec rm $lstf $errf $flist] }

cd $where
return $rc
}

#--------------------------------------------------------------
#  AddCpio  --  Add member(s)to a cpio archive
#
#    Note - this needs to be fixed to work just like lha...
#
#    Options supported:
#        None at present...  
#--------------------------------------------------------------
proc AddCpio {parent owner dirname arcname flist lstf errf} {
set thisproc "AddCpio"
global ErrArgs


set tmp "creating$parent"
global $tmp
set creating [set $tmp]
set tmp "apn$owner"
global $tmp
set apn [set $tmp]
set tmp "jpn$owner"
global $tmp
set jpn [set $tmp]
#set tmp "recurs$owner"
#global $tmp
#set recurs [set $tmp]
set tmp "ArcFno$parent"
global $tmp
set type [set $tmp]
set rc 0
set TheArcFile $dirname/$arcname
set xlist ""
set where [pwd]

if [ catch {set fl [open $flist r]} ]  {
#  puts "$thisproc:    open failure"
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

if {! $apn && ! $jpn}  {
  cd "/"
  }
set flags ""
set fno 0
foreach fn $xlist  {
if {! $apn}  {
#  set fn [string range $fn 1 end]
  }
#    ****  gotta specify append if not new file...
  if {! $jpn}  {
    if {! $apn}  {
      set fn [string range $fn 1 end]
      }
set here [pwd]
    if {$creating}  {
      if {$fno == 0}  {
        incr fno
        set rc [catch {exec echo "$fn" | cpio -o -F $TheArcFile 2>$errf} cc]
        }  else  {
        set rc [catch {exec echo "$fn" | cpio -oA -F $TheArcFile 2>$errf} cc]
        }
      }  else  {
      set rc [catch {exec echo "$fn" | cpio -oA -F $TheArcFile 2>$errf} cc]
      }
    }  else  {
    #  Junking the pathname (jpn)...absolute pathname is meaninless
    set l1 [string last "/" $fn]
    incr l1
    set fnn [string range $fn $l1 end]
    incr l1 -2
    set fnd [string range $fn 0 $l1]
    cd $fnd
    if {$creating}  {
      if {$fno == 0}  {
        incr fno
        set rc [catch {exec echo "$fnn" | cpio -o -F $TheArcFile 2>$errf} cc]
        }  else  {
        set rc [catch {exec echo "$fnn" | cpio -oA -F $TheArcFile 2>$errf} cc]
        }
      }  else  {
      set rc [catch {exec echo "$fnn" | cpio -oA -F $TheArcFile 2>$errf} cc]
      }
    }

  if {$rc != 0}  {
    break
    }
  }

cd $where
#  Put up a message box if error...
if {$rc != 0}  {
  set ErrArgs "$lstf $errf $TheArcFile"
  GErrMsgBox 88
  return $rc
  }

return $rc
}

#--------------------------------------------------------------
#  DelCpio  --  Delete member(s) from a cpio archive
#
#    Options supported:
#        None at present...  
#--------------------------------------------------------------
proc DelCpio {owner dirname arcname flist lstf errf} {
set thisproc "DelCpio"
global ErrArgs

set TheArcFile $dirname/$arcname
set rc -1

if {$rc != 0}  {
  set ErrArgs "delete cpio"
  GErrMsgBox 84
  return $rc
  }

return $rc
}






#--------------------------------------------------------
#  The Old Routines
#
#--------------------------------------------------------

#--------------------------------------------------------
#  Many things deleted...
#--------------------------------------------------------

#---------------------------------
#  KillArc  --  Destroy this view 
#---------------------------------
proc KillArc {owner}  {
global MenuHelp WinList TempDir

if {$MenuHelp}  {
  set MenuHelp 0
  ShowHelp 20
  return 1
  }

#  We need to clean up any temp files we left lying around
set tmp "TmpTar$owner"
global $tmp
set tmptar [set $tmp]
set tmp "tmparc$owner"
global $tmp
set tmparc [set $tmp]
set tmp "TmpBz$owner"
global $tmp
set tmpbz [set $tmp]
set tmp "TmpRar$owner"
global $tmp
set tmprar [set $tmp]
set tmp "TmpArj$owner"
global $tmp
set tmparj [set $tmp]
if {$tmparc != ""}  {
  catch [exec rm -f $tmparc]
  }
if {$tmptar != ""}  {
  catch [exec rm -f $tmptar]
  }
if {$tmpbz != ""}  {
  catch [exec rm -f $tmpbz]
  }
if {$tmprar != ""}  {
  catch [exec rm -f $tmprar]
  }
if {$tmparj != ""}  {
  catch [exec rm -f $tmparj]
  }
set tmp "Kill$owner"
global $tmp
set killist [set $tmp]
foreach file $killist  {
  if {[file isdirectory $file]}  {
    catch [exec rm -rf $file]
    }  else  {
    catch [exec rm -f $file]
    #  Arrrgh -- catch the case where file was used by us in an internal
    #  viewing call - if the temp dir it's in is empty (there could
    #  have been multiple files), then delete the dir also
    set l1 [string last "/" $file]
    if {$l1 != -1}  {
      incr l1 -1
      set tdir [string range $file 0 $l1]
      set l1 [string length $TempDir]
      set tdir2 [string range $tdir $l1 end]
      if {$tdir != ""}  {
        set fl ""
        catch {set fl [glob "$tdir/*"] }
        if {$fl == ""}  {
          catch [exec rm -rf $tdir]
          cd $TempDir
          }
        }
      }
    }
  }

set buttons ".$owner.top.but"
KillMyButtons "$buttons"
set oloc [string first "$owner" $WinList]
set oend [string first " " [string range $WinList $oloc end]]
if {$oend == -1}  {
  set oend [string length $WinList]
  }  else  {
  incr oend $oloc
  }
incr oloc -1
incr oend
set pt1 [string range $WinList 0 $oloc]
set pt2 [string range $WinList $oend end]
set WinList [string trim "$pt1$pt2"]
destroy .$owner
return 1
}


#--------------------------------
#  SelectOne  --  enable buttons 
#--------------------------------
proc SelectOne {owner}  {
global MainSelected

set tmp "SimpleCmp$owner"
global $tmp
set simple [set $tmp]
set tmp "ArcFno$owner"
global $tmp
set type [set $tmp]
set buttons ".$owner.top.but"
$buttons.view configure -state normal
$buttons.ext configure -state normal
if {! $simple && $type != 10 && $type != 11}  {
  $buttons.del configure -state normal
  }
.main.f2.but2.m1 entryconfigure 3 -state disabled \
  -foreground PowderBlue
.main.f2.but2.m1 entryconfigure 4 -state disabled \
  -foreground PowderBlue
set MainSelected 0
KillOtherButtons "$buttons"
return 1
}


#-----------------------------------------------------------
#  SelectAll  --  Select all the items in an archive list   
#-----------------------------------------------------------
proc SelectAll {owner arcname dirname}  {
global MenuHelp

if {$MenuHelp}  {
  set MenuHelp 0
  ShowHelp 21
  return 1
  }

set tmp "SimpleCmp$owner"
global $tmp
set simple [set $tmp]
set tmp "ArcFno$owner"
global $tmp
set type [set $tmp]
set alist "$owner.body.alist"
set buttons "$owner.top.but"
.$alist selection set 0 [.$alist size]
set cmd "SelectNone $owner $arcname $dirname"
.$buttons.selall configure -text "Deselect All" -command $cmd
.$buttons.view configure -state normal
.$buttons.ext configure -state normal
if {! $simple && $type != 10 && $type != 11}  {
  .$buttons.del configure -state normal
  }
return 1
}



#-----------------------------------------------------------
#  SelectNone  --  Select all the items in an archive list  
#-----------------------------------------------------------
proc SelectNone {owner arcname dirname}  {
global MenuHelp

if {$MenuHelp}  {
  set MenuHelp 0
  ShowHelp 21
  return 1
  }

set alist "$owner.body.alist"
set buttons "$owner.top.but"
.$alist selection clear 0 [.$alist size] 
set cmd "SelectAll $owner $arcname $dirname"
.$buttons.selall configure -text "Select All" -command $cmd
.$buttons.view configure -state disabled
.$buttons.ext configure -state disabled
.$buttons.del configure -state disabled

return 1
}


#-----------------------------------------------------------------------------
#  AddItem  --  Add Item(s) to an Archive
#-----------------------------------------------------------------------------
proc AddItem {owner arcname dirname}  {
global ErrArgs MenuHelp ArcWin MainButBg MainBg WhoBg
set thisproc "AddItem"
if {$MenuHelp}  {
  set MenuHelp 0
  ShowHelp 24
  return 1
  }

set WBg $MainBg
set WButBg $MainButBg
set EntBg "bisque"
set WFg "black"

#set win ".$owner"

#  OK, pop up a what'll ya have dialogue...
#-------------------------------------------------------------------
#  Make some unique names for us...
incr ArcWin
set thiswin "addmbr$ArcWin"
set WinName ".$thiswin"
set crfunc "crfunc$thiswin"
global $crfunc
set $crfunc 0
set tmp "creating$owner"
global $tmp
set creating [set $tmp]

if {$dirname == "dummy" && $arcname == "dummy"}  {
  set arcname ""
  set dirname [ GetCurDir "$owner" ]
  }
if {$dirname == "/dev"}  {
  GErrMsgBox 15;
  return -1;
  }

set arcn "arcname$thiswin"
global $arcn
set $arcn $arcname
set atype "ArcFno$owner"
global $atype
set type [set $atype]

set recurs "recurs$thiswin"
global $recurs
set $recurs 1
set apn "apn$thiswin"
global $apn
set $apn 0
set jpn "jpn$thiswin"
global $jpn
set $jpn 0

if [catch {toplevel $WinName}] {
  raise $WinName
  } else {
#  Build the window...
  set arctitle "Add to Archive"
  wm title $WinName $arctitle
  set topf [frame $WinName.top -bg $WBg -highlightbackground $WBg]
  set buttons [frame $topf.but -bg $WBg -highlightbackground $WBg]
  set namef [frame $WinName.top.namef -bg $WBg -highlightbackground $WBg]
  set typef [frame $WinName.top.types -bg $WBg -highlightbackground $WBg]
  set typef1 [frame $WinName.top.types.types1 -bg $WBg -highlightbackground $WBg]
  set typef2 [frame $WinName.top.types.types2 -bg $WBg -highlightbackground $WBg]

  set cmd "AddItem2 $owner $thiswin $arcname $dirname"
  button $buttons.add2arc -text "Add to Archive" -command $cmd \
    -bg $WButBg -highlightbackground $WButBg
  set cmd "KillCreate $thiswin"
set cmd "destroy $WinName"
  button $buttons.quit -text "Cancel" -command $cmd \
    -bg $WButBg -highlightbackground $WButBg
#  Gotta intercept wm killing the window with this command too
  wm protocol $WinName "WM_DELETE_WINDOW" $cmd
  wm protocol $WinName "WM_SAVE_YOURSELF" $cmd

  label $namef.where -text "   Directory:  " -relief flat -bg $MainBg
  entry $namef.dir -text " " -relief sunken -bg $WhoBg -width 30 \
  -font "-*-fixed-bold-*-*-*-*-*-*-*-*-*-*-1"
  label $namef.fndsc -text "   Archive Name:  " -bg $WBg -highlightbackground $WBg
  entry $namef.fname -textvariable $arcn -bg $EntBg -highlightbackground $EntBg -width 20
  label $namef.pad -text "    " -bg $WBg -highlightbackground $WBg
  checkbutton $typef1.rec -variable $recurs -text "Recurse Subdirectories" -bg $WBg -highlightbackground $WBg

  checkbutton $typef2.apn -variable $apn -text "Absolute Path Names" -bg $WBg -highlightbackground $WBg
  checkbutton $typef2.jpn -variable $jpn -text "No Path Names" -bg $WBg -highlightbackground $WBg

  pack $buttons.add2arc $buttons.quit -side left
  pack $namef.where $namef.dir $namef.fndsc $namef.fname $namef.pad -side left -expand no
  pack $typef1.rec -side left 
  pack $typef2.apn $typef2.jpn -side left
  pack $typef2 $typef1 -side bottom


#  Now build a file selection list for directory to create in & filename...
  set flbody [ frame $WinName.body  -bg $WBg -highlightbackground $WBg]
  set body $thiswin.body

  set stuff [BuildDirList "$body"]

  pack $flbody -anchor w -fill x -side bottom -fill both -expand yes
  
  pack $typef -side bottom -fill both -expand yes
  pack $namef -side bottom -anchor center 
  pack $buttons -side bottom
  
  pack $topf -side bottom -anchor center -expand yes -fill x

  set cradir "CraDir$body"
  global $cradir
  set $cradir $dirname
  set cmd "UpdCraDir $body"
  bind $flbody.list1.dirlist <Double-1> $cmd
  $flbody.list1.dirlist configure -selectmode extended
  $flbody.list2.arclist configure -selectmode extended
  set cmd "UpdCraDir2 $thiswin"
  bind $namef.dir <Return> $cmd


  $namef.dir configure -textvariable $cradir
  set $cradir [UpdDirList "$body" "$dirname"]

#  Now a few type-specific hacks...
#    - tar always recurses subdirs, won't junk pathnames
#    - zip has no absolute/relative pathname option
#    - only allow 1 selection, and no directories, for simple 
#      compressed files
switch $type    {
    1        -
    5        -
    14        {
        $typef1.rec configure -state disabled
#        $typef2.jpn configure -state disabled
        set $recurs 1
        }
    2        {
        $typef2.apn configure -state disabled
        }
    4        -
    6        -
    9        -
    12       -
    13       {
        $flbody.list1.dirlist configure -selectmode single
        $flbody.list2.arclist configure -selectmode single
        $typef2.apn configure -state disabled
        $typef1.rec configure -state disabled
        $typef2.jpn configure -state disabled
        set $recurs 0
        }
    3        -
    15       {
#        $typef2.apn configure -state disabled
        $typef1.rec configure -state disabled
#        $typef2.jpn configure -state disabled
        set $recurs 1
        }
    16       {
#        $typef2.apn configure -state disabled
        $typef1.rec configure -state disabled
#        $typef2.jpn configure -state disabled
        set $recurs 0
        }
    default  {

        }
    }

  }

return 1
}


#-----------------------------------------------------------------------------
#  AddItem2  --  Callback for the OK Do It button
#-----------------------------------------------------------------------------
proc AddItem2 {parent owner arcname dirname}  {
global ErrArgs TmpNo TempDir
set thisproc "AddItem2"

set atype "ArcFno$parent"
global $atype
set type [set $atype]
set jpn "jpn$owner"
global $jpn
#set $jpn 0

set body "$owner.body"
set cradir "CraDir$body"
global $cradir
set seldir [set $cradir]
#puts "$thisproc:    selected items from $seldir"

set nodirs 0
incr TmpNo
set tno $TmpNo
set lstf "$TempDir/TkzLst$tno"
set errf "$TempDir/TkzErr$tno"
set flist "$TempDir/TkzFlst$tno"
set killist "Kill$parent"
global $killist
set $killist "[set $killist] $lstf $errf $flist"

set dlist ".$owner.body.list1.dirlist"
set alist ".$owner.body.list2.arclist"

switch $type    {
    4        -
    6        -
    12       -
    13       {
        set nodirs 1
        }
    default  {
        set nodirs 0
        }
    }

set files ""
if {[$dlist curselection] != ""}  {
  if {$nodirs}  {
    #  You don't compress a directory...
    return 1
    }
  if {[set $jpn]}  {
    set ErrArgs "    "
    GErrMsgBox 82
    return 1
    }
  set sellist [$dlist curselection]
  foreach i $sellist {
    set files "$files [$dlist get $i $i]"
    }
  }  else  {
  set sellist [$alist curselection]
  foreach i $sellist {
    set files "$files [$alist get $i $i]"
    }
  }
set files [string trim $files]
#puts "files = <$files>"
if {$files == ""}  {
  return 1
  }

#  May need to append the dirname to all the filenames, depending on options...
set ff [open $flist w]
foreach file $files {
  puts $ff "$seldir/$file"
  }
catch {[close $ff]}


  #  OK, now do the dirty work...
  switch $type        {
      1        -
      3        -
      5        -
      14       {
          set rc [AddTar $parent $owner $dirname $arcname $flist $lstf $errf]
          }
      2        {
          set rc [AddZip $parent $owner $dirname $arcname $flist $lstf $errf]
          }
      4        {
          set rc [AddGzp $parent $owner $dirname $arcname $flist $lstf $errf]
          }
      6        {
          set rc [AddCmp $parent $owner $dirname $arcname $flist $lstf $errf]
          }
      9        {
          set rc [AddAr $parent $owner $dirname $arcname $flist $lstf $errf]
          }
      12       {
          set rc [AddShn $parent $owner $dirname $arcname $flist $lstf $errf]
          }
      13       {
          set rc [AddBzip $parent $owner $dirname $arcname $flist $lstf $errf]
          }
      15       {
          set rc [AddLha $parent $owner $dirname $arcname $flist $lstf $errf]
          }
      16       {
          set rc [AddCpio $parent $owner $dirname $arcname $flist $lstf $errf]
          }
      default  {
PluckFromList $owner "FLList"
destroy .$owner
set ErrArgs "Add-to-Archive"
GErrMsgBox 6
          }
      }


set tmp "creating$parent"
global $tmp
set creating [set $tmp]
if {$creating}  {
  RefDirs $dirname
  }
#  Destroy the window...
PluckFromList $owner "FLList"
destroy .$owner
#  Refresh all open filelist windows affected...
#  Now destroy the parent window and refresh the directory list...
KillArc $parent
DispArc $dirname $arcname 0 0

return 1
}



#-----------------------------------------------------------------------------
#  DelItem  --  Delete Item(s) from an Archive
#-----------------------------------------------------------------------------
proc DelItem {owner arcname dirname}  {
global ErrArgs MenuHelp TempDir TmpNo
set thisproc "DelItem"

if {$MenuHelp}  {
  set MenuHelp 0
  ShowHelp 25
  return 1
  }
if {$dirname == "/dev"}  {
  GErrMsgBox 15;
  return -1;
  }

set tmp "ArcFno$owner"
global $tmp
set arcfno [set $tmp]
incr TmpNo
set tno $TmpNo
set alist ".$owner.body.alist"
set sellist [$alist curselection]
set flist "$TempDir/TkzFlst$tno"
set lstf "$TempDir/TkzLst$tno"
set errf "$TempDir/TkzErr$tno"
set killist "Kill$owner"
global $killist
set $killist "[set $killist] $lstf $errf $flist"
#puts "$thisproc:    entered with arcfno = $arcfno, filelist = $flist"

BuildMbrList $owner "delete" $tno $arcfno


#  Use the generic routine where possible...
#  Note:  the delete function is very buggy with my version of GNU tar (1.11.8)...
#    - not TkZip's code, theirs. Can't recommend its use very highly.
switch $arcfno    {
    1       -
    3       -
    5       -
    14      {
        set rc [DelTar $owner $dirname $arcname $flist $lstf $errf]
        }
    9       {
        set rc [DelAr $owner $dirname $arcname $flist $lstf $errf]
        }
    15       {
        set rc [DelLha $owner $dirname $arcname $flist $lstf $errf]
        }
    16       {
        set rc [DelCpio $owner $dirname $arcname $flist $lstf $errf]
        }
    default       {
        set rc [DelItem2 $owner $dirname $arcname $flist $lstf $errf $arcfno]
        }
    }
#  Now destroy the original window and refresh the directory list...
KillArc $owner
DispArc $dirname $arcname 0 0

return 1
}


#-----------------------------------------------------------------------------
#  DelItem2  --  Generic delete routine works for most types...
#-----------------------------------------------------------------------------
proc DelItem2 {owner dirname arcname flist lstf errf arcfno}  {
global ErrArgs MenuHelp TempDir TmpNo
set thisproc "DelItem2"

set TheArcFile $dirname/$arcname
set xlist ""
if [ catch {set fl [open $flist r]} ]  {
  return -1
  }
while {[ gets $fl line ] > -1}  {
  set xlist "$xlist $line"
  }
catch [close $fl]

switch $arcfno    {
    2       {
        set flags "-d"
        set arcpgm "zip"
        }
    default       {
        set ErrArgs "Delete-from-Archive"
        GErrMsgBox 6
        return -1
        }
    }


foreach fn $xlist  {
#set cmd "$arcpgm $flags $TheArcFile $fn >$lstf 2>$errf"
#puts "Trying to exec\n '$cmd'  "
  set rc [catch {exec $arcpgm $flags $TheArcFile $fn >$lstf 2>$errf} cc]
#  puts "$thisproc:  got rc = $rc deleting $fn"
  }

return $rc
}




#------------------------------------------------------------------
#  SetArcVars  --  based on the generic type, set pgm & flags, etc.
#-----------------------------------------
#  Duhhh...lots of junk to clean out here.
#-----------------------------------------
#------------------------------------------------------------------
proc SetArcVars {owner fno} {
global ArcPgm UnarcPgm ArcFlags ListFlags ViewFlags ExtFlags FTypes ArcFno
global GotTar GotGtar GotGzip GotZip GotZcat GotCompress GotPgm Debug
global GotAr GotArj GotRar GotShn GotBzip GotLha GotCpio GotRpm
global GotPgms2 NoGotPgms2 NeededPgms2 GotPgmFlags2 NeededPgmFlags2

set thisproc "SetArcVars"
set GotPgm 1
set tartype "Tar Archive"
set plainzip "Zip Archive"
set zipexe "Self-Extracting Zip Executable"
set tarzip "Zipped Tar Archive"
set targzip "GNU-Zipped Tar Archive"
set gziptype "GNU Zipped File"
set comptype "Compressed File"
set comptar "Compressed Tar Archive"
set arfile "Archive/Lib"
set rarfile "RAR Archive"
set arjfile "ARJ Archive"
set shortfile "Shorten File"
set unktype "Unknown File Type"
set bziptype "Bzipped File"
set bziptar "Bzipped Tar Archive"
set lhatype "LHa (lzh) Archive"
set cpiotype "Cpio Archive"

set arcpgm "ArcPgm$owner"
set listflags "ListFlags$owner"
set viewflags "ViewFlags$owner"
set extflags "ExtFlags$owner"
set gotpgm "GotPgm$owner"

if {! [info exists $arcpgm] }  {
global $arcpgm
  }
if {! [info exists $listflags] }  {
global $listflags
  }
if {! [info exists $viewflags] }  {
global $viewflags
  }
if {! [info exists $extflags] }  {
global $extflags
  }
if {! [info exists $gotpgm] }  {
global $gotpgm
  }
set $gotpgm 1


switch $fno {
  1        { 
    set $arcpgm "tar"
    set $listflags "-ztvf"
    set $viewflags "-zxOf"
    set $extflags "-zxvf"
    set arctype $targzip
    if {! $GotTar} {
      set $gotpgm 0
      }
    }
  2        { 
    set $arcpgm "unzip"
    set $listflags "-v"
    set $viewflags "-p"
    set $extflags "-o"
    set arctype $plainzip
    if {! $GotZip} {
      set $gotpgm 0
      }
    }
  3        { 
    set $arcpgm "tar"
    set $listflags "-tvf"
    set $viewflags "-xOf"
    set $extflags "-xvf"
    set arctype $tartype
    if {! $GotTar} {
      set $gotpgm 0
      }
    }
  4        { 
    set $arcpgm "gunzip"
    set $listflags "-l"
    set $viewflags "-c"
    set $extflags ""
    set arctype $gziptype
    if {! $GotGzip} {
      set $gotpgm 0
      }
    }
  5        { 
    set $arcpgm "tar"
    set $listflags "-ztvf"
    set $viewflags "-zxOf"
    set $extflags "-zxvf"
    set arctype $comptar
    if {! $GotTar} {
      set $gotpgm 0
      }
    }
  6        {
    #  Use compress or zcat  --  ?
    #  zcat (gzip) is far more reliable on my system 
    if {$GotZcat}  {
      set $arcpgm "zcat"
      }  else  {
      set $arcpgm "uncompress"
      }
    set $listflags "-l"
    set $viewflags "-c"
    set $extflags ""
    set arctype $comptype
    if {! $GotZcat && ! $GotCompress} {
      set $gotpgm 0
      }
    }
  7        { 
    set $arcpgm "unzip"
    set $listflags "-v"
    set $viewflags "-p"
    set $extflags "-o"
    set arctype $zipexe
    if {! $GotZip} {
      set $gotpgm 0
      }
    }
  8        { 
    #  This is an obsolete placeholder - used to be a raw device...
    set $arcpgm "tar"
    set $listflags "-ztvf"
    set $viewflags "-zxOf"
    set $extflags "-zxvf"
    set arctype $targzip
    if {! $GotTar} {
      set $gotpgm 0
      }
    }
  9        { 
    #  Old Unix archive (static lib)
    set $arcpgm "ar"
    set $listflags "-t"
    set $viewflags "-x"
    set $extflags "-x"
    set arctype $arfile
    if {! $GotAr} {
      set $gotpgm 0
      }
    }
  10        { 
    #  ARJ archive
    set $arcpgm "unarj"
    set $listflags "l"
    set $viewflags "x"
    set $extflags "x"
    set arctype $arjfile
    if {! $GotRar} {
      set $gotpgm 0
      }
    }
  11        { 
    #  RAR archive...
    set $arcpgm "unrar"
    set $listflags "l"
    set $viewflags "x"
    set $extflags "x"
    set arctype $rarfile
    if {! $GotArj} {
      set $gotpgm 0
      }
    }
  12        { 
    #  Shorten file...
    set $arcpgm "shorten"
    set $listflags "-x"
    set $viewflags "-x"
    set $extflags "-x"
    set arctype $shortfile
    if {! $GotShn} {
      set $gotpgm 0
      }
    }
  13        { 
    #  Bzip file...
    set $arcpgm "bunzip"
    set $listflags ""
    set $viewflags "-c"
    set $extflags "-c"
    set arctype $bziptype
    if {! $GotBzip} {
      set $gotpgm 0
      }
    }
  14        { 
    set $arcpgm "tar"
    set $listflags "-ztvf"
    set $viewflags "-zxOf"
    set $extflags "-zxvf"
    set arctype $bziptar
    if {! $GotTar} {
      set $gotpgm 0
      }
    }
  15        { 
    set $arcpgm "lha"
    set $listflags "-v"
    set $viewflags "-x"
    set $extflags "-x"
    set arctype $lhatype
    if {! $GotLha} {
      set $gotpgm 0
      }
    }
  16        { 
    set $arcpgm "cpio"
    set $listflags "-tv"
    set $viewflags "-i"
    set $extflags "-i"
    set arctype $cpiotype
    if {! $GotCpio} {
      set $gotpgm 0
      }
    }

  default  {
    set $arcpgm "NoSuchPgm"
    set $listflags "-ztvf"
    set $viewflags "-zxOf"
    set $extflags "-zxvf"
    set arctype $unktype
    set $gotpgm 0
    }
  }

if {$Debug}  {
#  puts "$thisproc: for type $fno -    ArcPgm:     $arcpgm = [set $arcpgm]" 
#  puts "                             ViewFlags:  $viewflags = [set $viewflags]" 
  }

return $arctype
}


#------------------------------------------------
#  ViewItem  --  extract a file from arc & view
#------------------------------------------------
proc ViewItem {WinName arcname arcdir} {
global PgmName PgmNamelc ArcPgm ViewFlags ErrArgs TkzVer MainBg MainButBg Debug MyPid TmpNo TempDir
global FastClean MultView Vpn MenuHelp

if {$MenuHelp}  {
  set MenuHelp 0
  ShowHelp 22
  return 1
  }

set thisproc "ViewItem"
set viewbin "vbin$WinName"
global $viewbin
set vbin [set $viewbin]
set killist "Kill$WinName"
global $killist
incr TmpNo
set tno $TmpNo
set tmpf "$TempDir/TkzTmp$tno"
# Make it a dir instead, and use flist...
set flist "$TempDir/TkzFlst$tno"
set flist2 ""
set tmpd "$TempDir/TkzTmp$tno"
set errf "$TempDir/TkzErr$tno"
set $killist "[set $killist] $errf $flist"

if {$vbin == ""}  {
  GErrMsgBox 4
  return -1
  }

set tmp "ArcPgm$WinName"
global $tmp
set arcpgm [set $tmp]
set tmp "ViewFlags$WinName"
global $tmp
set viewflags [set $tmp]
set tmp "ArcFno$WinName"
global $tmp
set arcfno [set $tmp]


set alist ".$WinName.body.alist"
if {[$alist curselection] == ""}  {
  set ErrArgs $arcname
  GErrMsgBox 7
  return -1
  }
set item1ind [lindex [$alist curselection] 0]

#--------------   new stuff   -----------------

set sellist [$alist curselection]
if {! $MultView}  {
  set sellist [lindex $sellist 0]
  }
set ff [open $flist w]

foreach filind $sellist {
#------------------
  set tmp1 [$alist get $filind $filind]
  #  Account for symlinks (different pgms say it differently)...
  #  gotta do this first, because it affects locating the filename.
  set tmpi [string first "->" $tmp1]
  set tmpi2 [string first "link to" $tmp1]
  #  Just say no to symlinks...
  if {$tmpi != -1 || $tmpi2 != -1}  {
    continue
    }
#------------------
  #  Depending on file type, the filename may be the last field,
  #  or the first, or who-knows-what for newly added formats...
  switch    $arcfno        {
    10             -
    11             {
       #  ARJ & RAR have filename at beginning...
       set file [string trim [lindex [lindex $tmp1 0] 0]]
       }
    default        {
       #  Most have filename at the end (*or* it's the only field).
       set file [string trim [lindex [lindex $tmp1 0] end]]
       }
    }
#------------------
  #  ...and don't include directories 
  set tmpi [string last "/" $file]
  incr tmpi
  if {$file != "" && $tmpi != [string length $file]}  {
    #-----------------------------------
    #  Right here we have to strip the filename from path and add
    #  to our list to pass to viewer...
    #-----------------------------------
    set tmp [string range $file $tmpi end]
    set flist2 [string trim "$flist2 $tmp"]

    puts $ff $file
    }
#------------------

  }
catch { [close $ff] }

#-------------- end new stuff -----------------
catch [exec mkdir $tmpd]


switch $arcfno       {
      1           -
      5           -
      14           {
        #  Gzipped, compressed, or bzipped TAR archive
#        set item1 [lindex [$alist get [lindex [$alist curselection] 0] ] end]
        set rc [GetVTar $WinName $arcdir $arcname $flist $tmpd $errf]
        }
      2           -
      7           {
        #  ZIP archive
#        set item1 [lindex [$alist get [lindex [$alist curselection] 0] ] end]
        set rc [GetVZip $WinName $arcdir $arcname $flist $tmpd $errf]
        }
      3           {
        #  TAR archive
#        set item1 [lindex [$alist get [lindex [$alist curselection] 0] ] end]
        set rc [GetVTar $WinName $arcdir $arcname $flist $tmpd $errf]
        }
      4           {
        #  Gzipped file
#        set item1 [lindex [$alist get [lindex [$alist curselection] 0] ] end]
        set rc [GetVGzp $WinName $arcdir $arcname $flist $tmpd $errf]
        }
      6           {
        #  Compressed file
#        set item1 [lindex [$alist get [lindex [$alist curselection] 0] ] end]
        set rc [GetVCmp $WinName $arcdir $arcname $flist $tmpd $errf]
        }
      9           {
        #  AR archive/lib
#        set item1 [lindex [$alist get [lindex [$alist curselection] 0] ] 0]
        set rc [GetVAr $WinName $arcdir $arcname $flist $tmpd $errf]
        }
      10          {
        #  ARJ archive
#        set item1 [lindex [$alist get [lindex [$alist curselection] 0] ] 0]
        #  unarj often incorrectly displays file name as all upper when it will
        #  extract a lower-case filename. Bummer.
#        set item1 [string tolower $item1]
        set rc [GetVArj $WinName $arcdir $arcname $flist $tmpd $errf]
        }
      11          {
        #  RAR archive
#        set item1 [lindex [$alist get [lindex [$alist curselection] 0] ] 0]
        set rc [GetVRar $WinName $arcdir $arcname $flist $tmpd $errf]
        }
      12          {
        #  SHN (shorten) file
#        set item1 [lindex [$alist get [lindex [$alist curselection] 0] ] 0]
        set rc [GetVShn $WinName $arcdir $arcname $flist $tmpd $errf]
        }
      13          {
        #  Bzipped file
#        set item1 [lindex [$alist get [lindex [$alist curselection] 0] ] 0]
        set rc [GetVBzip $WinName $arcdir $arcname $flist $tmpd $errf]
        }
      15          {
        #  LHarc archive
#        set item1 [lindex [$alist get [lindex [$alist curselection] 0] ] end]
        set rc [GetVLha $WinName $arcdir $arcname $flist $tmpd $errf]
        }
      16          {
        #  Cpio archive
#        set item1 [lindex [$alist get [lindex [$alist curselection] 0] ] end]
        set rc [GetVCpio $WinName $arcdir $arcname $flist $tmpd $errf]
        }
      default     {
        #  This is the old style logic - works for all the old types...
#        set item1 [lindex [$alist get [lindex [$alist curselection] 0] ] end]
#        set rc [catch {exec $arcpgm $viewflags $arcdir/$arcname $item1 >$tmpf 2>$errf} cc]
        set rc -100
        }
      }


#  This obviously has to change...kluge for now, we'll never see this error!
if {$rc != 0}  {
  if { ! [file exists $tmpd] }  {
#    puts "Extract failed rc=$rc cc=$cc "
     if {$arcfno == 16 && $rc == 85}  {
       return -1
       }
     set ErrArgs "$vbin $file"
    GErrMsgBox 92
    return -1
    }
  }

#  Kluge for now...only pass 1 to ourselves -- we'll fix later!
# set tmpf [lindex $flist2 0]
# set tmpf "$tmpd/$tmpf"
#
#  If the viewer is ourselves, just do an internal call.
#  ...and ignore any opts they may have tried to set.
 set pgm [lindex $vbin 0]
 if {$pgm == $PgmName || $pgm == $PgmNamelc}  {
    #--------------
    foreach tmpf $flist2  {
        set tmpf "$tmpd/$tmpf"
      #  Gotta split the filename from the directory path...bummer!
      #  Why did I think that was useful on intial entry?
      set lsl [string last "/" $tmpf]
      if {$lsl < 0}  {
        set theDir [pwd]
        set theFile $tmpf
        }
      if {$lsl == 0}  {
        set theDir "/"
        set theFile [string range $tmpf 1 end]
        }
      if {$lsl > 0}  {
        set theDir [string range $tmpf 0 [expr $lsl - 1]]
        set theFile [string range $tmpf [expr $lsl + 1] end]
        }
      DispArc $theDir $theFile 0 0
      }
    #--------------
   }  else  {
   #  Otherwise, spawn an external viewer...
   #  Probably should have an option to suppress this killist stuff.
   #  May have a bad effect on, for example, a sound or video player.
   if {$FastClean}  {
     set $killist "[set $killist] $tmpf"
     }

   set where [pwd]
   cd $tmpd

# --  Need to add parsing for opts - new syntax:
#     pgmname -opts $*    (not really needed)
#     pgmname -opts$*     (needed; for example,  edith -b$*)
#
   if {$Vpn}  {
     set flist3 ""
     foreach file $flist2  {
       set flist3 "$flist3 $tmpd/$file"
       }
     set flist2 [string trim $flist3]
     }
   set cmd "$vbin"
   if {[string last "\$*" $cmd] == -1}  {
     set cmd "$cmd \$*"
     }
   set tmpi [string last "\$*" $cmd]
   while {$tmpi != -1}  {
     incr tmpi -1
     set tmpc [string range $cmd 0 $tmpi]
     incr tmpi 3
     set tmpc2 [string range $cmd $tmpi end]
     set cmd "$tmpc$flist2$tmpc2"
     set tmpi [string last "\$*" $cmd]
     }
   set cmd "exec $cmd &"

   if [catch  {set awwshit [eval $cmd]}] {
#     puts "View failed "
     set ErrArgs "$vbin $file"
     GErrMsgBox 90
     return -1
     }
   cd $where
   }


return 1
}


#----------------------------------------------------
#  SetViewer  --  set the viewer to use for this file
#----------------------------------------------------
proc SetViewer {WinName arcname arcdir vn} {
global VNames VBins VNum
global MenuHelp

if {$MenuHelp}  {
  set MenuHelp 0
  ShowHelp 26
  return 1
  }

set vdp "VDPending$WinName"
global $vdp
set delflag [set $vdp]
if {$delflag}  {
  DeleteViewer $WinName $arcname $arcdir $vn
  return 1
  }

set thisproc "SetViewer"
set viewer "vnam$WinName"
set viewbin "vbin$WinName"
set viewnum "vnum$WinName"
set vbname ".$WinName.top.vopt.vname"
set vbentry ".$WinName.top.vopt.vbin"
set menu ".$WinName.top.but.selv.m"
global $viewer $viewbin $viewnum

if {$vn == $VNum}  {
  $vbname configure -state normal
  $vbentry configure -state normal
  }  else  {
  $vbname configure -state disabled
  $vbentry configure -state disabled
  }
set $viewer $VNames($vn)
set $viewbin $VBins($vn)

return 1
}


#----------------------------------------------------
#  AddViewer  --  add a user-selected viewer to list 
#----------------------------------------------------
proc AddViewer {WinName arcname arcdir} {
global VNames VBins VNum ViewButtons

set thisproc "AddViewer"
set viewer "vnam$WinName"
set viewbin "vbin$WinName"
set vbname ".$WinName.top.vopt.vname"
set vbentry ".$WinName.top.vopt.vbin"
global $viewer $viewbin 



    set label "[set $viewer]"
    set bin "[set $viewbin]"
    # "Nothing will come of nothing."  - King Lear, I, 1  
    if {[string trim "$bin" " "] != ""}  {
      $vbname configure -state disabled
      $vbentry configure -state disabled
      set ovn $VNum
      incr VNum
      set nvn $VNum
      if {$label == "User defined"}  {
        set label "$bin"
        }

#  Update menu for all active views...
      foreach buttons "$ViewButtons"  {
        #  Have to extract win name from buttons - 
	set wn [string range "$buttons" 1 [expr [string last ".top.but" "$buttons"] - 1]]
        set menu "$buttons.selv.m"
        set VNames($ovn) "$label"
        set VBins($ovn) "$bin"
        set VNames($nvn) "User defined"
        set VBins($nvn) ""
        #  A nasty little hack because 4.0 propagates the visual checked state of the last 
	#  radiobutton in the menu - so delete & re-add the little sucker...
#	$menu delete $ovn
#        $menu add radiobutton -label "$label" -command "SetViewer $wn $arcname $arcdir $ovn" \
#          -indicatoron 1
        #  OK, enough - just hide the damned things. Should have used plain old buttons.
        $menu add radiobutton -label "User defined" -command "SetViewer $wn $arcname $arcdir $nvn" \
          -indicatoron 0
        $menu entryconfigure $ovn -label "$label"
        }

      } 

return 1
}


#----------------------------------------------------
#  SetViewerDelete  --  set viewer deletion pending...
#----------------------------------------------------
proc SetViewerDelete {owner} {
global VNames VBins VNum
global MenuHelp

set vdp "VDPending$owner"
global $vdp
set $vdp 1

}


#----------------------------------------------------
#  DeleteViewer  --  delete the clicked viewer
#----------------------------------------------------
proc DeleteViewer {owner arcname arcdir vn} {
global VNames VBins VNum ViewButtons
global MenuHelp VDWarn ErrArgs

set thisproc "DeleteViewer"
set vdp "VDPending$owner"
global $vdp
set $vdp 0

#  Never delete "User defined"...
if {$vn == $VNum || $vn < 1}  {
  return 1
  }

#  Do the warning thing till the user gets tired of that...
if {$VDWarn}  {
  set ErrArgs $VBins($vn)
  set rc [GModMsgBox $owner 103]
  if {! $rc}  {
    return 1
    }
  }

#  Disable the menus while we work...
foreach buttons "$ViewButtons"  {
  #  Have to extract win name from buttons - 
  set wn [string range "$buttons" 1 [expr [string last ".top.but" "$buttons"] - 1]]
  set mb "$buttons.selv"
  $mb configure -state disabled
  }

#  We'll want to reset the selected viewer name if it's the one we're deleting...
set TheViewer $VNames($vn)
set TheBinary $VBins($vn)

#  Now update the list...
set vn1 $vn
set vn2 $vn1
incr vn2
while {$vn1 < $VNum}  {
  set VNames($vn1) $VNames($vn2)
  set VBins($vn1) $VBins($vn2)
  incr vn1
  incr vn2
  }
unset VNames($VNum)
unset VBins($VNum)
incr VNum -1

#  OK, it's gone from the list. Now update all the active menus (groan...)
foreach buttons "$ViewButtons"  {
  #  Have to extract win name from buttons - 
  set wn [string range "$buttons" 1 [expr [string last ".top.but" "$buttons"] - 1]]
  set mb "$buttons.selv"
  set menu "$buttons.selv.m"
  set vn1 $vn

  while {$vn1 <= $VNum}  {
    $menu entryconfigure $vn1 \
      -label "$VNames($vn1)" -command "SetViewer $wn $arcname $arcdir $vn1" \
      -indicatoron 0
    incr vn1
    }
  $menu delete $vn1
  $mb configure -state normal

  #  If deleted viewer was selected for this window, reset selection
  set viewer "vnam$wn"
  set viewbin "vbin$wn"
  set vbname ".$wn.top.vopt.vname"
  set vbentry ".$wn.top.vopt.vbin"
  global $viewer $viewbin 
  set label "[set $viewer]"
  set bin "[set $viewbin]"
  if {$label == $TheViewer && $bin == $TheBinary}  {
    set $viewer $VNames(1)
    set $viewbin $VBins(1)
    }

  }

return 1
}



#------------------------------------------------
#  ExtractItems  --  extract files from arc
#------------------------------------------------
proc ExtractItems {WinName arcname arcdir} {
global PgmName ArcPgm ErrArgs TkzVer WhoBg MainBg MainButBg ExtWin CurExtDir ExtDirSel
global ViewFlags ExtFlags MyPid TmpNo TempDir Debug Home
global OvWarn OvOpt ForceStat MenuHelp ExtDirs

if {$MenuHelp}  {
  set MenuHelp 0
  ShowHelp 23
  return 1
  }

set thisfunc "ExtractItems"
set thisproc "ExtractItems"
incr ExtWin
set this "Ext$ExtWin"
set this "$WinName$this"
set owner "$WinName"
set thiswin ".$this"
set alist ".$WinName.body.alist"
set WBg $MainBg
set WButBg $MainButBg

set tmp "ArcPgm$WinName"
global $tmp
set arcpgm [set $tmp]
set tmp "ExtFlags$WinName"
global $tmp
set extflags [set $tmp]
set tmp "ArcType$WinName"
global $tmp
set arctype [set $tmp]
set tmp "ArcFno$WinName"
global $tmp
set arcfno [set $tmp]
set tmp "sdirl$owner"
global $tmp
set $tmp ""

set statw ".$WinName.top.vopt.stat"
set stat "Stat$WinName"
global $stat
set $stat "          "
$statw configure -textvariable $stat -fg red

incr TmpNo
set tno $TmpNo
set lstf "$TempDir/TkzLst$tno"
set errf "$TempDir/TkzErr$tno"

set olddir [ pwd ]
set ExtDirSel 0
set sellist [$alist curselection]

#------------------------------
#  Duhhh...  clean this up.
#------------------------------
#  If all are selected, we don't want to waste time with individual selections...
set tmp [llength $sellist]
if { $tmp == [$alist size] && $tmp > 1 }  {
  set selall 1
#  For now, force off for ar, arj, and rar
  if {$arcfno == 9 || $arcfno == 10 || $arcfno == 11}  {
    set selall 0
    }
  }  else  {
  set selall 0
  }
set maybeall $selall
if {$selall}  {
  if {$OvWarn || ! $OvOpt}  {
    set selall 0
    }
  }
#------------------------------

set howmanyl [$alist size]
set howmanys [llength $sellist]
if { [llength $sellist] == 1 }  {
  set justone 1
  }  else  {
  set justone 0
  }

#  Moved dir sel block...
#  Find out where they want to put this stuff

if [catch {toplevel $thiswin}] {
  raise $thiswin
  } else {
  set arctitle "Select Extract-to Directory for:  $arcname"
  wm title $thiswin $arctitle
  set topf [frame $thiswin.top -bg $WBg -highlightbackground $WBg]
  set buttons [frame $topf.but -bg $WBg]
  set archdr [frame $topf.hdr -bg $WBg] 
  set arcbody [frame $thiswin.body]
  set body "$this.body"

#------------------------------
#  More cd'ing to purge...
#------------------------------
  set cdvar "CurDir$body"
  global $cdvar
  set $cdvar $arcdir
#  Why is this here...?
  if { ! [info exists $cdvar] } {
    global $cdvar
    }
#------------------------------

  set cmd "destroy $thiswin"
  button $buttons.quit -text "Cancel" -command $cmd \
    -bg $WButBg -highlightbackground $WButBg
  set cmd "SelDir $this"
  button $buttons.sel -text "Extract" \
    -bg $WButBg -highlightbackground $WButBg \
    -command $cmd
  label $archdr.l1 -text "Directory to Extract to: " -bg $WBg -width 25
  entry $archdr.where -text " " -relief sunken -bg $WhoBg -width 40 -textvariable $cdvar \
    -font "-*-fixed-bold-*-*-*-*-*-*-*-*-*-*-1"

  pack $buttons.quit $buttons.sel -side left -anchor w -expand no 
  pack $buttons -side top -anchor n
  pack $archdr.l1 $archdr.where -side left -fill x -anchor center
  pack $archdr -fill x -anchor center
  pack $topf -anchor w -fill x
  pack $arcbody -anchor w -fill x -side bottom -fill both -expand yes
  

#  Now build a file selection list for extract-to dir...

  set stuff [BuildDirList "$body"]

  set cmd "UpdExtDir $body"
  bind $arcbody.list1.dirlist <Double-1> $cmd
  set cmd "UpdExtDir2 $this"
  bind $archdr.where <Return> $cmd

  set seldir [UpdDirList "$body" "$arcdir"]
  set tmp "ExtDir$body"
  global $tmp
  set $tmp $seldir
  set tmp "ExtDirSel$this"
  global $tmp
  set $tmp 0

  tkwait window $thiswin

  # After this point, none of the selection list vars exists...
  # set dlist ".$body.list1.dirlist"
  # puts "List = $dlist"

PluckFromList $body "FLList"
set tmp "ExtDir$body"
set seldir [set $tmp]
set tmp "ExtDirSel$this"
set extdirsel [set $tmp]


#------------------------------
#  More cd'ing to purge...
#------------------------------
cd $seldir
#------------------------------

#  Moved dir sel block...
if {$extdirsel}  {
  set $stat "Checking selections"
  $statw configure -fg red -width 26
  update idletasks
  }  else  {
  return 1
  }



#  Build a filelist for extracting  
set flist "$TempDir/TkzFlst$tno"
set flist2 ""
set flist3 ""
#---------------------------
if {! $selall}  {
set ff [open $flist w]

      set flnum [llength $sellist]
      set flct 0
      set extpercent 0
      foreach filind $sellist {

	      incr flct
#	      set extpct [expr 100 / [expr $flnum / $flct]]
	      set extpct [expr [expr 100 * $flct] / $flnum]
	      if {$extpct != $extpercent}  {
	        set extpercent $extpct
	        set $stat "Checking selections  $extpct %"
	        update idletasks
	        }

	set tmp1 [$alist get $filind $filind]
	#  Account for symlinks (different tars say it differently)...
        #  gotta do this first, because it affects locating the filename.
	set tmpi [string first "->" $tmp1]
	set tmpi2 [string first "link to" $tmp1]
	if {$tmpi != -1}  {
	  incr tmpi -1
	  set tmp1 [string range $tmp1 0 $tmpi]
	  set tmp1 "$tmp1\}"
	  }  else  {
	    if {$tmpi2 != -1}  {
	      incr tmpi2 -1
	      set tmp1 [string range $tmp1 0 $tmpi2]
	      set tmp1 "$tmp1\}"
	      }
	  }

        #  Depending on file type, the filename may be the last field,
        #  or the first, or who-knows-what for newly added formats...
        switch    $arcfno        {
          10             -
          11             {
            #  ARJ & RAR have filename at beginning...
	    set file [string trim [lindex [lindex $tmp1 0] 0]]
            }
          default        {
            #  Most have filename at the end (*or* it's the only field).
	    set file [string trim [lindex [lindex $tmp1 0] end]]
            }
          }

        #  ...and don't include directories 
        set tmpi [string last "/" $file]
	incr tmpi
        if {$tmpi == [string length $file]}  {
          set isdir 1
          }  else  {
          set isdir 0
          }
#  The new handling...

        if {$file != ""}  {
          if {[file exists $file]}  {
            #  ...and do the overwrite warning thing here.
            if {[WarnOverWrite "$owner" "$file"]}  {
#puts "OK to overwrite $file"
              if {$isdir}  {
                set flist3 [concat $flist3 $file]
                }  else  {
                puts $ff $file
                set flist2 [concat $flist2 $file]
                }
	      }  else  {
              set maybeall 0
#puts "Can't overwrite $file"
	      }
	    }  else  {
            if {$isdir}  {
              set flist3 [concat $flist3 $file]
              }  else  {
              puts $ff $file
              set flist2 [concat $flist2 $file]
              }
	    }
	  }


        }
    catch { [close $ff] }
  }
#---------------------------

set selall $maybeall
if {$selall}  {
#puts "Doing the selall thing..."
  set file "*"
  set flist2 "*"
  set flist3 ""
  set ff [open $flist w]
  puts $ff $flist2
  catch { [close $ff] }
  }

set tmp "sdirl$owner"
set $tmp $flist3

#-------------------------------------
#  The new handling...
#-------------------------------------
#  
#  
#  If there's nothing left in the list, don't call
#  the extractors...
if {$flist2 == "" && $flist3 == ""}  {
  $statw configure -fg black
  set $stat "   Done   "
  set $stat "Nothing to Extract"
  return 1
  }

  if {$extdirsel} {

    switch    $arcfno        {
      1              -
      5              -
      14              {
        #  Extract from Gzipped, Compressed, or Bzipped TAR...
        #  These cd's are temp till we obliterate all the ancient dir changing logic
        catch { cd {$olddir} }
        set rc [ExtTar $owner $arcdir $arcname $seldir $file $flist $lstf $errf]
#        return 1
        }
      2              -
      7              {
        #  Extract from ZIP...
        #  These cd's are temp till we obliterate all the ancient dir changing logic
        catch { cd {$olddir} }
        set rc [ExtZip $owner $arcdir $arcname $seldir $file $flist $lstf $errf]
#        return 1
        }
      3              {
        #  Extract from TAR...
        #  These cd's are temp till we obliterate all the ancient dir changing logic
        catch { cd {$olddir} }
        set rc [ExtTar $owner $arcdir $arcname $seldir $file $flist $lstf $errf]
#        return 1
        }
      4              {
        #  Extract from Gzipped file...
        #  These cd's are temp till we obliterate all the ancient dir changing logic
        catch { cd {$olddir} }
        set rc [ExtGzp $owner $arcdir $arcname $seldir $file $flist $lstf $errf]
#        return 1
        }
      6              {
        #  Extract from Compressed file...
        #  These cd's are temp till we obliterate all the ancient dir changing logic
        catch { cd {$olddir} }
        set rc [ExtCmp $owner $arcdir $arcname $seldir $file $flist $lstf $errf]
#        return 1
        }
      9              {
        #  Extract from AR...
        #  These cd's are temp till we obliterate all the ancient dir changing logic
        catch { cd {$olddir} }
        set rc [ExtAr $owner $arcdir $arcname $seldir $file $flist $lstf $errf]
#        return 1
        }
      10             {
        #  Extract from ARJ...
        catch { cd {$olddir} }
        set rc [ExtArj $owner $arcdir $arcname $seldir $file $flist $lstf $errf]
#        return 1
        }
      11             {
        #  Extract from RAR...
        catch { cd {$olddir} }
        set rc [ExtRar $owner $arcdir $arcname $seldir $file $flist $lstf $errf]
#        return 1
        }
      12             {
        #  Extract from SHN...
        catch { cd {$olddir} }
        set rc [ExtShn $owner $arcdir $arcname $seldir $file $flist $lstf $errf]
#        return 1
        }
      13             {
        #  Extract from BZIP...
        catch { cd {$olddir} }
        set rc [ExtBzip $owner $arcdir $arcname $seldir $file $flist $lstf $errf]
#        return 1
        }
      15             {
        #  Extract from LHA...
        catch { cd {$olddir} }
        set rc [ExtLha $owner $arcdir $arcname $seldir $file $flist $lstf $errf]
#        return 1
        }
      16             {
        #  Extract from CPIO...
        catch { cd {$olddir} }
        set rc [ExtCpio $owner $arcdir $arcname $seldir $file $flist $lstf $errf]
#        return 1
        }
      default        {
        #  Can't happen, right?
        return -1
        }
      #  End switch...
      }
    }




#-------------------------------------
#  All the stuff below here should 
#  eventually disappear...
#  As soon as we get the error catching logic back
#  up to par, delete it.
#-------------------------------------
#  Done.
#-------------------------------------

  #  NewStuff-1
  #  Update the main File list if it's pointing to...aww, hell, just
  #  update the darned thing anyway, just in case.
  #  One of these days, we should put in a directory list list - all
  #  dir windows would register/unregister themselves...maybe next week...
  #  set tmp "CurDirmain"
  #  global $tmp
  #  set curdir [set $tmp]
  #  set mainl "main"
  #  UpdDirList $mainl $curdir
  #
  #  **  Better idea...refresh everything in the global list
  #

  }
  RefDirs $seldir
return 1
}



#------------------------------------------------------------
#  BuildMbrList  --  build list of selected members to act on
#------------------------------------------------------------
proc BuildMbrList {owner func tno arcfno} {
global TempDir WarnOverWrite

set alist ".$owner.body.alist"
set sellist [$alist curselection]
set flist "$TempDir/TkzFlst$tno"
set flist2 ""
if {$func == "extract"}  {
  set extracting 1
  }  else  {
  set extracting 0
  }

#  Build a list of members to act on
set ff [open $flist w]

set flnum [llength $sellist]
set flct 0
set extpercent 0
#-------------------------
foreach filind $sellist {

  incr flct
  if {$extracting}  {
    set extpct [expr [expr 100 * $flct] / $flnum]
    if {$extpct != $extpercent}  {
      set extpercent $extpct
      set $stat "Checking selections  $extpct %"
      update idletasks
      }
    }

  set tmp1 [$alist get $filind $filind]
  #  Account for symlinks (different tars say it differently)...
  #  gotta do this first, because it affects locating the filename.
  set tmpi [string first "->" $tmp1]
  set tmpi2 [string first "link to" $tmp1]
  if {$tmpi != -1}  {
    incr tmpi -1
    set tmp1 [string range $tmp1 0 $tmpi]
    set tmp1 "$tmp1\}"
    }  else  {
    if {$tmpi2 != -1}  {
      incr tmpi2 -1
      set tmp1 [string range $tmp1 0 $tmpi2]
      set tmp1 "$tmp1\}"
      }
    }

  #  Depending on file type, the filename may be the last field,
  #  or the first, or who-knows-what for newly added formats...
  switch    $arcfno        {
    10             -
    11             {
      #  ARJ & RAR have filename at beginning...
      set file [string trim [lindex [lindex $tmp1 0] 0]]
      }
    default        {
      #  Most have filename at the end (*or* it's the only field).
      set file [string trim [lindex [lindex $tmp1 0] end]]
      }
    }

  #  ...and don't include directories 
#----------------
  if {$extracting}  {
    set tmpi [string last "/" $file]
    incr tmpi
    if {$file != "" && $tmpi != [string length $file]}  {
      if {[file exists $file]}  {
        #  ...and do the overwrite warning thing here.
        if {[WarnOverWrite "$owner" "$file"]}  {
          puts $ff $file
          set flist2 [concat $flist2 $file]
          }
        }  else  {
        puts $ff $file
        set flist2 [concat $flist2 $file]
        }
      }
    }  else  {
    puts $ff $file
    set flist2 [concat $flist2 $file]
    }
#----------------


  }
    catch { [close $ff] }



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


return 1
}





#----------------------------------------------------
#  UpdExtDir  --  Update the Extract-to dir from the 
#    filelist entry the user double-clicked on
#----------------------------------------------------
proc UpdExtDir {owner}  {
global CurExtDir ExtDirSel Debug

set thisproc "UpdExtDir"

KillViewButtons
set arcbody ".$owner"
set l1 [$arcbody.list1.dirlist curselection]
if {$l1 == ""}  {
  return 1
  }
set dirn [$arcbody.list1.dirlist get [$arcbody.list1.dirlist curselection]]
set seldir [UpdDirList "$owner" "$dirn"]

set tmp "ExtDir$owner"
global $tmp
set $tmp $seldir

set CurExtDir $seldir
set ExtDirSel 0


return seldir
}

#----------------------------------------------------
#  UpdExtDir2  --  Update the Extract-to dir from the
#    entry field, the user just hit enter
#----------------------------------------------------
proc UpdExtDir2 {owner}  {
global CurExtDir ExtDirSel Debug

set thisproc "UpdExtDir2"

KillViewButtons
set arcbody ".$owner"

set dirn [.$owner.top.hdr.where get]
set seldir [UpdDirList "$owner.body" "$dirn"]

set tmp "ExtDir$owner.body"
global $tmp
set $tmp $seldir

set CurExtDir $seldir
set ExtDirSel 0


return seldir
}





proc SelDir {owner} {
global Debug
set thisproc "SelDir"

if {$Debug}  {
#  puts "$thisproc:    Entered with arg owner = $owner."
#  puts "           Setting dir selected, destroying $owner."
  }
set tmp "ExtDirSel$owner"
global $tmp
set $tmp 1
destroy .$owner

return 1
}


#----------------------------------------------------
#  UpdCraDir  --  update the directory to create a 
#    new archive in
#----------------------------------------------------
proc UpdCraDir {owner}  {
global CurCraDir Debug

set thisproc "UpdCraDir"

KillViewButtons
set arcbody ".$owner"
set tmpd "CraDir$owner"
global $tmpd
set cradir [set $tmpd]
set l1 [$arcbody.list1.dirlist curselection]
if {$l1 == ""}  {
  return $cradir
  }
set dirn [$arcbody.list1.dirlist get $l1]
set cradir [UpdDirList "$owner" "$dirn"]

set tmpd "CraDir$owner"
global $tmpd
set $tmpd $cradir

set CurCraDir $cradir

return $cradir
}


#----------------------------------------------------
#  UpdCraDir2  --  update the directory to create a 
#    new archive in
#----------------------------------------------------
proc UpdCraDir2 {owner}  {
global CurCraDir Debug

set thisproc "UpdCraDir"

KillViewButtons
#set arcbody ".$owner"
set dirn [.$owner.top.namef.dir get]
set cradir [UpdDirList "$owner.body" "$dirn"]

set tmp "CraDir$owner.body"
global $tmp
set $tmp $cradir

set CurCraDir $cradir

return $cradir
}




#----------------------------------------------------
#  GErrMsgBox  --  general error msg box
#    -- cleaned up and made properly reentrant...
#       split the modal stuff out into another func.
#----------------------------------------------------
proc GErrMsgBox {gerrno} {
global PgmName ErrArgs TkzVer TmpNo MainBg MainButBg Debug NoGotPgms
global NoGotPgms2 DseFlag
set thisproc "GErrMsgBox"
#  Defaults...
set maxerr 100
set quitword "OK"
set quitbg "Red"
set yesword "Yes"
incr TmpNo
set tno $TmpNo
global action
set action 0

switch $gerrno {

  1              {
    #  Error trying to read the archive...
    set arcname [lindex $ErrArgs 0]
    set winname ".badname"
    set wintitle "$PgmName:    --  Oops!"
    set winhdr "- Wrong or Unknown File Type -"
    set winaspect 300
    set NoGots "$NoGotPgms$NoGotPgms2"
    if {$NoGots != ""}  {
      set whatsmissing "\n    (We were unable to locate the following programs, or compatible versions thereof, \
      on your system:\n		$NoGots\nThis could possibly be the cause.)"
      }  else  {
      set whatsmissing ""
      }
    set errtext "    Sorry, but '$arcname' does not appear to be a type of file supported by \
        $PgmName version $TkzVer. $whatsmissing\
	\n\n    If you think \
	you have a file of a standard type that we should recognize, please E-mail the author at proteus@pcnet.com \
	with a brief description."
    }

  2              {
    #  For trying to enter /proc...
    set quitbg $MainButBg
    set winname ".noproc"
    set wintitle "$PgmName:    --  Oops!"
    set winhdr "- Proc -"
    set winaspect 600
    set errtext "    '/proc' is a special filesystem used for process management and special system \
      functions. It is not a normal directory, and there are no archives there. \
      $PgmName will not enter it."
    }

  3              {
    #  Unable to locate archive pgm...
    set pgmname [lindex $ErrArgs 0]
    set winname ".nopgm"
    set wintitle "$PgmName:    --  Oops!"
    set winhdr "- Archive Program '$pgmname' Missing -"
    set winaspect 600
    set errtext "    The program '$pgmname' is needed to read this type of archive, \
      and could not be located on this system."
    }

  4              {
    #  User-defined viewer not entered...
    set winname ".noview"
    set wintitle "$PgmName:    --  Oops!"
    set winhdr "- User-Defined Viewer Not Specified -"
    set winaspect 600
    set errtext "    You selected the User-Defined Viewer, but did not enter the program name. \
      Please enter the name of the binary executable or script \
      you wish to use for a viewer (you may enter a full path name if necessary)."
    }

  5              {
    #  No E-mail address...
    set what     [lindex $ErrArgs 0]
    set winname ".noid"
    set wintitle "$PgmName:    --  No E-mail Address"
    set winhdr "- No E-mail Address -"
    set winaspect 600
    set errtext "    We cannot E-mail the $what form without your E-mail address. \
    Please enter your user id and hostname in the fields provided.\
    \n\n    (If we were able to determine the address of the machine you are running on, then \
    we pre-entered that information. However, some systems do not respond nicely to a polite \
    request for a fully qualified domain name.)"
    }

  6              {
    #  Function not implemented yet...
    set quitbg $MainButBg
    set funcname [lindex $ErrArgs 0]
    set winname ".nofunc"
    set wintitle "$PgmName:    --  $funcname"
    set winhdr "- $funcname Not Implemented Yet -"
    set winaspect 600
    set errtext "    $funcname is not yet implemented in $PgmName version $TkzVer. \
      \n\n    This is a pre-release beta version, and there are several pieces still missing. \
      The button you just pushed is one of them. It is scheduled to be connected by release 1.0.0. "
    }

  7              {
    #  Nothing selected to view...
    set quitbg $MainButBg
    set arcname [lindex $ErrArgs 0]
    set winname ".novsel"
    set wintitle "$PgmName:    --  Oops!"
    set winhdr "- Nothing Selected to View -"
    set winaspect 600
    set errtext "    You requested to view the selected item from '$arcname', but there is nothing selected. \
      \nClick on the item you wish to view and try again (or just double-click the item.) "
    }

  8              {
    #  Nothing selected to view...
    set quitbg $MainButBg
    set winname ".noasel"
    set wintitle "$PgmName:    --  Oops!"
    set winhdr "- Nothing Selected to View -"
    set winaspect 600
    set errtext "    You requested to view the selected archive, but there is nothing selected. \
      \nClick on the item you wish to view and try again (or just double-click the item.) "
    }

  9              {
    #  Info - we saved reg or bug form...
    set quitbg $MainButBg
    set filename [lindex $ErrArgs 0]
    set what     [lindex $ErrArgs 1]
    set winname ".fsaved"
    set wintitle "$PgmName:    --  $what Form Saved"
    set winhdr "- $what Form Saved -"
    set winaspect 600
    set errtext "    The $what form for $PgmName version $TkzVer has been saved as $filename. "
    }

  10              {
    #  Info - we sent reg or bug form...
    set quitbg $MainButBg
    set author   [lindex $ErrArgs 0]
    set what     [lindex $ErrArgs 1]
    set winname ".fsent"
    set wintitle "$PgmName:    --  $what Form Sent"
    set winhdr "- $what Form Sent -"
    set winaspect 600
    set errtext "    The $what form for $PgmName version $TkzVer has been sent to $author. "
    }

  11              {
    #  E-mail is fubar...
    set author   [lindex $ErrArgs 0]
    set what     [lindex $ErrArgs 1]
    set winname ".fnotsent"
    set wintitle "$PgmName:    --  $what Failed"
    set winhdr "- $what Failed -"
    set winaspect 600
    set errtext "    The attempt to E-mail the $what form for $PgmName version $TkzVer to $author \
      failed."
    }

  12              {
    #  Error, but only partial...
    set arcname  [lindex $ErrArgs 0]
    set errfl    [lindex $ErrArgs 1]
    set errfltxt [exec cat $errfl]
    set winname ".direrr"
    set wintitle "$PgmName:    --  Error Reading Archive Directory"
    set winhdr "- Error Reading $arcname -"
    set winaspect 300
    set errtext "    An error occurred trying to read the directory of $arcname. The file is probably corrupted, but \
      may be partially usable. The following is the text of the error message(s) returned.\n\n-------------------------------- \
      \n$errfltxt\n--------------------------------\n\n    If you \
      attempt to extract any items that may show up in the partial directory list, they may or may not extract successfully. \
      The extracted file(s) may be OK, even though the extract returns an error. Unfortunately, there is no way for $PgmName \
      to determine this. You will have to examine them to make that determination."
    }

  13              {
    #  Can't find mail agent...
    set author   [lindex $ErrArgs 0]
    set what     [lindex $ErrArgs 1]
    set winname ".fnotsent"
    set wintitle "$PgmName:    --  $what Failed"
    set winhdr "- $what Failed -"
    set winaspect 600
    set errtext "    The attempt to E-mail the $what form for $PgmName version $TkzVer to $author \
      failed because $PgmName was unable to locate a standard AT&T style mail command on your system. \
      Save the form as a file instead, and E-mail that via your standard method."
    }

  14              {
    #  Nothing selected to delete...
    set quitbg $MainButBg
    set winname ".nodasel"
    set wintitle "$PgmName:    --  Oops!"
    set winhdr "- Nothing Selected to Delete -"
    set winaspect 600
    set errtext "    You requested to delete the selected archive, but there is nothing selected. \
      \nClick on the item you wish to delete and try again. "
    }

  15              {
    #  Nothing selected to view...
    set quitbg $MainButBg
    set winname ".noupddev"
    set wintitle "$PgmName:    --  Oops!"
    set winhdr "- Attempt to Update Device -"
    set winaspect 600
    set errtext "    $PgmName does not support updating, creation, or deletion of files on a device."
    }

  16              {
    #  For trying to enter /proc...
    set dirname [lindex $ErrArgs 0]
    set winname ".notdir"
    set wintitle "$PgmName:    --  Oops!"
    set winhdr "- $dirname -"
    set winaspect 600
    set errtext "    '$dirname' is a directory used by $PgmName for temporary files. Since these files are\
      apt to disappear without warning, you would probably not enjoy trying to view them.\
     \n    $PgmName would definitely not enjoy having you try to update them, so it will not enter this directory."
    }

  17              {
    #  For trying to enter /proc...
    set dirname [lindex $ErrArgs 0]
    set winname ".nodir"
    set wintitle "$PgmName:    --  Oops!"
    set winhdr "- $dirname -"
    set winaspect 600
    set errtext "    '$dirname' does not exist. This version of $PgmName does not implicitly create new directories. "
    }


  79              {
    #  Gotta close all windows before changing cache...
    set oldname [lindex $ErrArgs 0]
    set newname [lindex $ErrArgs 1]
    set winname ".cachec"
    set wintitle "$PgmName:    --  Cache Changed!"
    set winhdr "- Cache Changed -"
    set winaspect 600
    set errtext "    The cache directory has been successfully changed to $newname.\n      The old cache\
      ($oldname) has been deleted."
    } 

  80              {
    #  Gotta close all windows before changing cache...
    set oldname [lindex $ErrArgs 0]
    set winname ".nocachec"
    set wintitle "$PgmName:    --  Oops!"
    set winhdr "- Can't Change Cache -"
    set winaspect 600
    set errtext "    You must close all the other open $PgmName windows before changing the cache directory.\
      \n      This is necessary to empty the current cache ($oldname.)"
    } 

  81              {
    #  Can't create the new cache directory...
    set oldname [lindex $ErrArgs 0]
    set newname [lindex $ErrArgs 1]
    set winname ".nocache"
    set wintitle "$PgmName:    --  Oops!"
    set winhdr "- Can't Create Cache Directory -"
    set winaspect 600
    set errtext "    $newname could not be created for the cache directory. $PgmName is continuing to use the\
      old cache directory. The current cache is $oldname."
    } 

  82              {
    #  Can't add directory and suppress pathnames...
    set filename [lindex $ErrArgs 0]
    set winname ".nodirjpn"
    set wintitle "$PgmName:    --  Oops!"
    set winhdr "- Can't Add Directory -"
    set winaspect 600
    set errtext "    You cannot add a directory with the \"No Path Names\" option set. Think about it. \"No Path\
      Names\" directs us to strip the directory path component off all the filenames you selected.\n      Now, what\
      you selected is nothing but a directory path...do you see where we're heading with this?"
    } 

  83              {
    #  Extract failed...
    set filename [lindex $ErrArgs 0]
    set winname ".nodupc2"
    set wintitle "$PgmName:    --  Oops!"
    set winhdr "- Compress to Self -"
    set winaspect 600
    set errtext "    $PgmName does not allow compressing a file into itself. To compress $filename,\
      try using a standard suffix, or a different name."
    } 

  84              {
    #  Function not supported...
    set func [lindex $ErrArgs 0]
    set pgm [lindex $ErrArgs 1]
    set winname ".nofunc"
    set wintitle "$PgmName:    --  Oops!"
    set winhdr "- Function not Supported -"
    set winaspect 600
    set errtext "    There is no $func function supported by the $pgm program."
    } 

  85              {
    #  Extract failed...
    set filename [lindex $ErrArgs 0]
    set winname ".novext2"
    set wintitle "$PgmName:    --  Oops!"
    set winhdr "- View Failed -"
    set winaspect 600
    set errtext "    $filename cannot be extracted for viewing. cpio does not give\
      us the ability to extract a file with an absolute pathname (beginning with a \"/\")\
      to a temporary file for viewing."
    } 

  86              {
    #  Shorten Heuristic used...
    set filename [lindex $ErrArgs 0]
    set option [lindex $ErrArgs 1]
    set winname ".shnheur"
    set wintitle "$PgmName:    --  Not to Worry!"
    set winhdr "- Shorten Heuristic -"
    set winaspect 400
    set errtext "    $PgmName had to tinker with the Shorten options to create $filename. The option used was $option.\n\n    "
    } 

  87              {
    #  Delete failed...
    set lstname [lindex $ErrArgs 0]
    set errname [lindex $ErrArgs 1]
    set filename [lindex $ErrArgs 2]
    set errfltxt [exec cat $errname]
    set winname ".nodel"
    set wintitle "$PgmName:    --  Oops!"
    set winhdr "- Delete from Archive Failed -"
    set winaspect 300
    set errtext "    Attempt to delete member(s) from $filename failed. The command output has \nbeen saved in $lstname and $errname.\n\n    The \
      following is the text of the error message(s) returned.\n\n-------------------------------- \
      \n$errfltxt\n--------------------------------\n\n    "
    } 

  88              {
    #  Add failed...
    set lstname [lindex $ErrArgs 0]
    set errname [lindex $ErrArgs 1]
    set filename [lindex $ErrArgs 2]
    set errfltxt [exec cat $errname]
    set winname ".noadd"
    set wintitle "$PgmName:    --  Oops!"
    set winhdr "- Add toArchive Failed -"
    set winaspect 300
    set errtext "    Attempt to add member(s) to $filename failed. The command output has \nbeen saved in $lstname and $errname.\n\n    The \
      following is the text of the error message(s) returned.\n\n-------------------------------- \
      \n$errfltxt\n--------------------------------\n\n    "
    } 

  89              {
    #  Create failed...
    set lstname [lindex $ErrArgs 0]
    set errname [lindex $ErrArgs 1]
    set filename [lindex $ErrArgs 2]
    set errfltxt [exec cat $errname]
    set winname ".nocre"
    set wintitle "$PgmName:    --  Oops!"
    set winhdr "- Archive Creation Failed -"
    set winaspect 300
    set errtext "    Archive creation for $filename failed. The command output has \nbeen saved in $lstname and $errname.\n\n    The \
      following is the text of the error message(s) returned.\n\n-------------------------------- \
      \n$errfltxt\n--------------------------------\n\n    "
    } 

  90              {
    #  Extract failed...
    set viewname [lindex $ErrArgs 0]
    set filename [lindex $ErrArgs 1]
    set winname ".noview"
    set wintitle "$PgmName:    --  Oops!"
    set winhdr "- View Failed -"
    set winaspect 600
    set errtext "    The external program  $viewname  could not be invoked to view  $filename. \n    It is\
      most likely not present on your system, or not in your path."
    } 

  91              {
    #  Extract failed...
    set lstname [lindex $ErrArgs 0]
    set errname [lindex $ErrArgs 1]
    set lstname2 [lindex $ErrArgs 2]
    set errname2 [lindex $ErrArgs 3]
    set errfltxt [exec cat $errname2]
    if {$DseFlag}  {
      set wesavedit ""
      }  else  {
      set wesavedit "The command output has been saved in $lstname and $errname."
      }
    set winname ".noext"
    set wintitle "$PgmName:    --  Oops!"
    set winhdr "- Extract Failed -"
    set winaspect 300
    set errtext "    The Extract failed. $wesavedit\n\n    The \
      following is the text of the error message(s) returned.\n\n-------------------------------- \
      \n$errfltxt\n--------------------------------\n\n    In some cases (most commonly a \
      premature eof), the files you wanted may have been successfully extracted. $PgmName does not attempt to make \
      that determination for you, because, even though a file may have been extracted, $PgmName has no way to verify \
      its validity or integrity."
    } 

  92              {
    #  View extract failed...
    set viewname [lindex $ErrArgs 0]
    set filename [lindex $ErrArgs 1]
    set winname ".novext"
    set wintitle "$PgmName:    --  Oops!"
    set winhdr "- View Failed -"
    set winaspect 600
    set errtext "    $filename could not be extracted for viewing."
    } 

  
  default        {
    #  A real bad thing just happened...
    set winname ".unkerr"
    set wintitle "$PgmName:    --  PROGRAM BUG:  Unknown Error ($gerrno) Raised"
    set winhdr "- Unknown Error Condition -"
    set winaspect 300
    set errtext "    An error condition (error code = $gerrno) has occurred for which no error handling \
      routine exists. This is a program bug, and generally considered a Bad Thing.\n    If you will \
      E-mail the author a brief description of what you were doing when this error occurred, he will \
      shamefacedly fix the bug for the next release. Please include the error number when reporting \
      this problem.\n    Registered users may receive the corrected version by E-mail."
    }

  }

set winname "$winname$tno"

if [catch {toplevel $winname}] {
  destroy $winname
  toplevel $winname
  }

wm title $winname $wintitle
frame $winname.f -bg $quitbg -highlightbackground $quitbg
frame $winname.f.f2 -width 20 -bg $quitbg -highlightbackground $quitbg
frame $winname.f.f3 -bg white
set cmd "destroy $winname"

button $winname.f.f2.quit -bg $MainBg -highlightbackground $MainBg -width 3 -text "$quitword" \
  -command $cmd
label $winname.f.f3.hdr -bg white \
  -font "-*-*-bold-*-*-*-*-200-*-*-*-*-*-1"\
  -text $winhdr
message $winname.f.f3.msg -bg white -fg red -justify left -aspect $winaspect \
  -text $errtext 

pack $winname.f.f2.quit -pady 3 -expand no
pack $winname.f.f3.hdr -pady 6 
pack $winname.f.f3.msg -pady 6 -expand yes
#pack $winname.f.f2 $winname.f.f3 -side left
pack $winname.f.f2 -side left -padx 8 -pady 6 -expand no
pack $winname.f.f3 -side right
pack $winname.f

set rc 0

return $rc
}



#-----------------------------------------------------
#  GModMsgBox  --  general modal msg box
#    -- for the things where you have to answer yes-no
#    -- note that multiple concurrent instances of these
#       will get handled in a LIFO manner
#-----------------------------------------------------
proc GModMsgBox {owner gerrno} {
global PgmName ErrArgs TkzVer TmpNo MainBg MainButBg Debug NoGotPgms
global NoGotPgms2
set thisproc "GModMsgBox"
#  Defaults...
set maxerr 100
set quitword "No"
set quitbg "Red"
set yesword "Yes"
incr TmpNo
set tno $TmpNo

set act "Act$owner"
global $act
set action 0
set $act action


switch $gerrno {

  101              {
    #  Overwrite warning...
    set filename [lindex $ErrArgs 0]
    set winname ".ovwarn$owner$tno"
    set wintitle "$PgmName:    --  Overwrite Warning"
    set winhdr "-  Overwriting Existing File!  -"
    set winaspect 600
    set errtext "    File '$filename' already exists. Overwrite anyway?"
    } 

  102              {
    #  Debug warning...
    set dbdata $ErrArgs
    set winname ".dbwarn$owner$tno"
    set wintitle "$PgmName:    --  Debug Pause"
    set winhdr "-  Debug Pause  -"
    set winaspect 800
    set errtext "    Pausing for Debug. Debug data:\n\n  $dbdata \n\n    Continue?"
    } 
  
  103              {
    #  Delete Viewer warning...
    set viewname [lindex $ErrArgs 0]
    set winname ".vdwarn$owner$tno"
    set wintitle "$PgmName:    --  Delete Viewer Warning"
    set winhdr "-  Delete Viewer?  -"
    set winaspect 600
    set errtext "    Do you really wish to delete '$viewname' from the viewer list?"
    } 
  
  104              {
    #  Delete File warning...
    set filename [lindex $ErrArgs 0]
    set winname ".adwarn$owner$tno"
    set wintitle "$PgmName:    --  Delete File Warning"
    set winhdr "-  Delete File?  -"
    set winaspect 600
    set errtext "    Do you really wish to delete '$filename'?"
    } 

  105              {
    #  Overwrite warning...
    set filename [lindex $ErrArgs 0]
    set winname ".crwarn$owner$tno"
    set wintitle "$PgmName:    --  Overwrite Warning"
    set winhdr "-  Overwriting Existing File!  -"
    set winaspect 600
    set errtext "    File '$filename' already exists. Overwrite anyway?\
      \n\n    Please not that if you reply \"Yes\" the existing file will be deleted,\
      even if you cancel the Create Archive dialogue before you finish creating the new file."
    } 

  106              {
    #  Compress this file? query...
    set filename1 [lindex $ErrArgs 0]
    set filename2 [lindex $ErrArgs 1]
    set winname ".comprq$owner$tno"
    set wintitle "$PgmName:    --  Compress File?"
    set winhdr "-  Compress File  -"
    set winaspect 600
    set errtext "    Compress file '$filename1' as '$filename2'?    \n\n"
    } 

  
  default        {
    #  Never heard of it...
    GErrMsgBox $gerrno
    return 0
    }

  #  End switch...
  }


if [catch {toplevel $winname}] {
  destroy $winname
  toplevel $winname
  }

wm title $winname $wintitle
frame $winname.f -bg $quitbg -highlightbackground $quitbg
frame $winname.f.f2 -width 20 -bg $quitbg -highlightbackground $quitbg
frame $winname.f.f3 -bg white

set cmd "set $act 0"
button $winname.f.f2.quit -bg $MainBg -highlightbackground $MainBg -width 3 -text "$quitword" \
  -command $cmd
set cmd "set $act 1"
button $winname.f.f2.doit -bg $MainBg -highlightbackground $MainBg -width 3 -text "$yesword" \
  -command $cmd
label $winname.f.f3.hdr -bg white \
  -font "-*-*-bold-*-*-*-*-200-*-*-*-*-*-1"\
  -text $winhdr
message $winname.f.f3.msg -bg white -fg red -justify left -aspect $winaspect \
  -text $errtext 

pack $winname.f.f2.quit -pady 3 -expand no
pack $winname.f.f2.doit -pady 3 -expand no
pack $winname.f.f3.hdr -pady 6 
pack $winname.f.f3.msg -pady 6 -expand yes
#pack $winname.f.f2 $winname.f.f3 -side left
pack $winname.f.f2 -side left -padx 8 -pady 6 -expand no
pack $winname.f.f3 -side right
pack $winname.f

tkwait var $act
set action [set $act]
destroy $winname
unset $act

return $action

}




#-----------------------------------------------------------------------------
#  WarnOverWrite  --  Warn of overwriting an existing file -
#-----------------------------------------------------------------------------
proc WarnOverWrite {owner file}  {
global OvWarn OvOpt ErrArgs

set reply $OvOpt
if {$reply && $OvWarn}  {
  set ErrArgs "$file"
  set action [GModMsgBox $owner 101]
  if {! $action}  {
#    puts "User said to don't do that."
    set reply 0
    }
  }
return $reply
}






#-----------------------------------------------------------------------------
#  Help  --  Very quick & very dirty
#-----------------------------------------------------------------------------
proc ShowHelp {context}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug MenuHelp
set thisproc "ShowHelp"

if {$MenuHelp && $context == 1}  {
  set MenuHelp 0
  ShowHelp 17
  return 1
  }

#set hbg "FloralWhite"
set hbg "linen"
set win ".help"
set wintitle "Help"

switch $context {

        1         -
        01        -
        02a       -
        02        -
        03        -
        04        -
        05        -
        06        -
        07        -
        08        -
        09        -
        10        -
        11        -
        12        -
        13        -
        14        -
        15        -
        16        -
        17        -
        18        -
        19        -
        20        -
        21        -
        22        -
        23        -
        24        -
        25        -
        26        -
        27        -
        28        -
        29        -
        30        -
        31        -
        32        -
        33        -
        34        -
        35        -
        36        -
        37        -
        38        -
        39        -
        40        -
        41        -
        42        -
        43        {

                  }
        default   {
            return 1
                  }

        }



if [catch {toplevel $win} rc]  {
  raise $win
  return 1
  }
  # Define our widgets
  wm title $win $wintitle
  text $win.ht1
  scrollbar $win.sby
  frame $win.f2
  set cmd "destroy $win"
  button $win.f2.hb1 -text "Ok" -bg $MainButBg -command $cmd
  # Tell the window mgr how to put 'em together
  pack $win.f2.hb1
  pack $win.f2 -side top -fill x
  pack $win.sby -side right -fill y
  pack $win.ht1 -fill both -expand yes
#  $win.ht1 configure -height 20

  # Now set up the text
  # Define some styles
  $win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
  $win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*
  $win.ht1 tag configure big -font -*-Times-Bold-R-Normal--*-140-*-*-*-*-*-*
  $win.ht1 tag configure reallybig -font -*-Times-Bold-R-Normal--*-180-*-*-*-*-*-*
  $win.ht1 tag configure cbig -font -*-Times-Bold-R-Normal--*-140-*-*-*-*-*-* -justify center
  $win.ht1 tag configure creallybig -font -*-Times-Bold-R-Normal--*-180-*-*-*-*-*-* -justify center
  $win.ht1 tag configure center -justify center
  $win.ht1 tag configure heading -font -*-Times-Bold-R-Normal--*-240-*-*-*-*-*-* -justify center
  $win.ht1 tag configure raised -relief raised -borderwidth 3
  $win.ht1 tag configure hilite -foreground red
  $win.ht1 tag configure italic -font -*-*-*-O-Normal-*-*-120-*-*-*-*-*-*



switch $context  {

	1		{

    		  set text "    This is a rather spartan beginning of a Help file. It'll get fancier later, but for now I'd\
		    rather spend my time on functionality, rather than bells and whistles like hypertext. Besides, beta users are supposed\
		    to be a hardy lot.\n\n    $PgmName version $TkzVer is a pre-release beta version which only handles\
		    extracting and viewing. Archive creation/updating willl be added before the initial formal release (1.0.0).\n"

		  $win.ht1 insert end "\n$PgmName\n\n" heading
		  $win.ht1 insert end "$text" italic

		  $win.ht1 insert end "\nCommand Line" creallybig
		  $win.ht1 insert end "\n    The program has a few command line arguments that should rarely be needed." normal 
		  $win.ht1 insert end "\n\n$PgmName   --version   --debug   filename" cbig
		  $win.ht1 insert end "\n\n--version,  -v        " big
		  $win.ht1 insert end "\n    Echoes the current version to stdout and exits." normal 
		  $win.ht1 insert end "\n\n--debug        " big
		  $win.ht1 insert end "\n    Causes the undocumented Debug Mode option to be inserted in the Options menu.\
		    Does not actually turn on debugging, just enables it. Since this code is in beta test,\
		    the behavior of this option is apt to be capricious at best. Much of the debug code is likely commented out, anyway." normal 
		  $win.ht1 insert end "\n\nfilename        " big
		  $win.ht1 insert end "\n    If a file name is given on the command line, the program opens a window showing\
		    the contents of that archive." normal 

		  $win.ht1 insert end "\n\nMain Screen" creallybig
		  $win.ht1 insert end "\n    The main screen provides a scrolling directory/file list from which you select\
		    the archive which you want to operate on. Double-click on the file you want to look at to open it. You may\
		    open as many archive view windows as you wish." normal 
		  $win.ht1 insert end "\n\nThe Buttons" cbig
		  $win.ht1 insert end "\n    (For help on individual buttons or menu items, right-click (button 3) on the\
		    button or menu item - except for trivial buttons like \"OK\" or \"Cancel\".)" normal

                  #  Explain Exit
                  Help01 $win 0

                  #  Explain the File menu
                  Help02a $win 0

                  #  Explain the Options menu
                  Help07 $win 0

                  #  Explain the Help menu
                  Help15 $win 0


		  $win.ht1 insert end "\n\nThe Entry Field" cbig
		  $win.ht1 insert end "\n\nCurrent Directory:       " big
		  $win.ht1 insert end "\n    This field is updated as you navigate through the directory tree, but if you get impatient\
		    (\"Hell, I just want to get to '/'\") or really like typing long pathnames, just enter a directory name here and hit enter." normal
 
		  $win.ht1 insert end "\n\nArchive Contents Screen" creallybig
		  $win.ht1 insert end "\n    This provides a scrolling list from which you select\
		    the files on which you want to operate. Double-click on a file you want to look at to view it." normal 
		  $win.ht1 insert end "\n\nThe Buttons" cbig
		  $win.ht1 insert end "\n\nClose        " big
		  $win.ht1 insert end "\n    Does just what you would expect it to. Closes the archive view." normal 
		  $win.ht1 insert end "\n\nSelect All   " big
		  $win.ht1 insert end "\n    Do you really need to ask? Selects all files in the current archive. Actually, it toggles between\
		    \"Select All\" and \"Deselect All\"." normal 
		  $win.ht1 insert end "\n\nView         " big
		  $win.ht1 insert end "\n    Has the same effect as double-clicking an entry in the file list. Invokes an external viewing\
		    program for the selected item. If more than one item in the list is selected, it will only spawn a viewer for the first\
		    selected file." normal 
		  $win.ht1 insert end "\n\nExtract      " big
		  $win.ht1 insert end "\n    Extracts all selected items from the archive. Opens a directory selection window for you to\
		    choose the directory into which you wish to extract the files. " normal 
		  $win.ht1 insert end "\n\nAdd          " big
		  $win.ht1 insert end "\n    Not implemented yet." normal 
		  $win.ht1 insert end "\n\nDelete       " big
		  $win.ht1 insert end "\n    Not implemented yet." normal 

                  #  Explain Select Viewer
                  Help26 $win 0

		  $win.ht1 insert end "\n\nThe Entry Fields" cbig
		  $win.ht1 insert end "\n\nViewer       " big
		  $win.ht1 insert end "\n    A descriptive name for the viewer. When this field says \"User defined\", both fields are made\
		    enterable, and you may enter the viewer of your choosing. If you do not enter a descriptive name, the name of the binary\
		    will be used by default." normal 
		  $win.ht1 insert end "\n\nExecutable   " big
		  $win.ht1 insert end "\n    The actual name of the executable binary. If you hit Enter (Return) while in this field, this viewer\
		    will be added to the \"Select Viewer\" menu. Otherwise, this viewer will be used only so long as it appears in this field, but\
		    will be forgotten when you select another viewer.\n    The viewer selection is unique to each opened window. Changing the\
		    selection for one window does not alter the selected viewer for other windows. However, the\
		    selection menu is global: adding a viewer updates the menu for all windows. If you Save Options,\
		    any additions you have made to the viewer list will be saved." normal 


		}

        01        {
                Help01 $win 1
                }

        02a        {
                Help02a $win 1
                }

        02        {
                Help02 $win 1
                }

        03        {
                Help03 $win 1
                }

        04        {
                Help04 $win 1
                }

        05        {
                Help05 $win 1
                }

        06        {
                Help06 $win 1
                }

        07        {
                Help07 $win 1
                }

        08        {
                Help08 $win 1
                }

        09        {
                Help09 $win 1
                }

        10        {
                Help10 $win 1
                }

        11        {
                Help11 $win 1
                }

        12        {
                Help12 $win 1
                }

        13        {
                Help13 $win 1
                }

        14        {
                Help14 $win 1
                }

        15        {
                Help15 $win 1
                }

        16        {
                Help16 $win 1
                }

        17        {
                Help17 $win 1
                }

        18        {
                Help18 $win 1
                }

        19        {
                Help19 $win 1
                }

        20        {
                Help20 $win 1
                }

        21        {
                Help21 $win 1
                }

        22        {
                Help22 $win 1
                }

        23        {
                Help23 $win 1
                }

        24        {
                Help24 $win 1
                }

        25        {
                Help25 $win 1
                }

        26        {
                Help26 $win 1
                }

        27        {
                Help27 $win 1
                }

        28        {
                Help28 $win 1
                }

        29        {
                Help29 $win 1
                }

        30        {
                Help30 $win 1
                }

        31        {
                Help31 $win 1
                }

        32        {
                Help32 $win 1
                }

        33        {
                Help33 $win 1
                }

        34        {
                Help34 $win 1
                }

        35        {
                Help35 $win 1
                }

        36        {
                Help36 $win 1
                }

        37        {
                Help37 $win 1
                }

        38        {
                Help38 $win 1
                }

        39        {
                Help39 $win 1
                }

        40        {
                Help40 $win 1
                }

        41        {
                Help41 $win 1
                }

        42        {
                Help42 $win 1
                }

        43        {
                Help43 $win 1
                }

	default   {
		return 1
		}

	}

# Set the other attributes

set ycmd "$win.sby set"
$win.ht1 configure -bg $hbg -wrap word -state disabled \
  -yscroll $ycmd 
$win.f2 configure -bg RosyBrown
set ycmd "$win.ht1 yview"
$win.sby configure -command $ycmd


return 1
}


#-----------------------------------------------------------------------------
#  Help 01  --  Explain Exit (sheesh!)
#-----------------------------------------------------------------------------
proc Help01 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help01"

if {$only}  {
  $win.ht1 configure -height 7
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure big -font -*-Times-Bold-R-Normal--*-140-*-*-*-*-*-*

$win.ht1 insert end "\n\nExit        " big
$win.ht1 insert end "\n    Does just what you would expect it to. Closes all windows and terminates the program." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 02a  --  Explain the File menu
#-----------------------------------------------------------------------------
proc Help02a {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help02a"

$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure big -font -*-Times-Bold-R-Normal--*-140-*-*-*-*-*-*

$win.ht1 insert end "\n\nFile        " big

Help02 $win 0
Help03 $win 0
Help04 $win 0
Help05 $win 0
Help06 $win 0

return 1
}


#-----------------------------------------------------------------------------
#  Help 02  --  Explain Exit again
#-----------------------------------------------------------------------------
proc Help02 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help02"

if {$only}  {
  $win.ht1 configure -height 6
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Exit              " bold
$win.ht1 insert end "\n      Just like the main Exit button." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 03  --  Explain New Archive
#-----------------------------------------------------------------------------
proc Help03 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help03"

if {$only}  {
  $win.ht1 configure -height 18
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  New Archive    " bold
$win.ht1 insert end "\n      Opens a Create Archive dialogue. First, you will be\
  presented with a \"Name That File\" window, in which you specify the name and\
  type of archive you want to create. You will be warned if the name you picked\
  is a file that already exists. Double-clicking on a name in the file list causes that\
  name to be inserted into the name entry field.\
  \n    If you proceed, you will then get a directory list of an \"empty\"\
  archive or compressed file (it doesn't actually exist at this point), with only\
  the \"Add\" and \"Close\" buttons active. Use the Add function to select one or\
  more files, as appropriate, to archive or compress. If you close the window without\
  adding anything, your new file will not be created.\
  \n    You may find that $PgmName has played games with the name you selected. This\
  is because it tries to mimic the behavior (whether desirable or not) of the target\
  archiving programs. If you try to create a tar called \"Some-old-goofy-stuff\", then\
  that's what $PgmName will call it, because tar is perfectly happy with that. But, if\
  you try to create a zip by the same name, TkZip will call it \"Some-old-goofy-stuff.zip\",\
  because that's what zip will change the name to. (No, you can't override this behavior.\
  Get a job.)\n      If the \"Use Standard Name Extensions\" option is checked, $PgmName will\
  always enforce standard naming conventions. Also, all names entered by double-clicking in\
  the file list get standard extensions, regardless of the state of this option." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 04  --  Explain Open Archive
#-----------------------------------------------------------------------------
proc Help04 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help04"

if {$only}  {
  $win.ht1 configure -height 12
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Open Archive      " bold
$win.ht1 insert end "\n      Opens a view window for the currently selected archive, displaying its directory contents\
  in a scrolling window. Has the same effect as double clicking on the filename. \n      $PgmName will attempt to\
  determine the type of archive file it is, and invoke the appropriate\
  program to read it." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 05  --  Explain Delete Archive
#-----------------------------------------------------------------------------
proc Help05 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help05"

if {$only}  {
  $win.ht1 configure -height 8
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Delete Archive    " bold
$win.ht1 insert end "\n      Deletes the currently selected file.\n      Note that this is a simple utility file\
  delete function. The file need not be an archive of any sort. No check is made of the file type: any kind of\
  file can be deleted." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 06  --  Explain Show Sys Info
#-----------------------------------------------------------------------------
proc Help06 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help06"

if {$only}  {
  $win.ht1 configure -height 8
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Show System Info      " bold
$win.ht1 insert end "\n      Opens a window showing various system configuration information, such as the $PgmName release\
  and build date, and the Tcl/Tk release you're using. Among other things, it shows a\
  checklist of which archive programs needed by $PgmName were or were not located on your system." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 07  --  Explain the Options menu
#-----------------------------------------------------------------------------
proc Help07 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help07"

$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure big -font -*-Times-Bold-R-Normal--*-140-*-*-*-*-*-*

$win.ht1 insert end "\n\nOptions     " big

Help08 $win 0
Help09 $win 0
Help10 $win 0
Help11 $win 0
Help12 $win 0
Help13 $win 0
Help27 $win 0
Help28 $win 0
Help29 $win 0
Help30 $win 0
Help31 $win 0
Help32 $win 0
Help33 $win 0
Help34 $win 0
Help35 $win 0
Help36 $win 0
Help37 $win 0
Help38 $win 0
Help39 $win 0
Help40 $win 0
Help41 $win 0
Help42 $win 0
Help14 $win 0
#		  $win.ht1 insert end "\n\n      There may be other checkbuttons on the menu as placeholders, but as of this release, they have no\
#		    effect, and should be permanently greyed out." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 08  --  Explain Show Archives Only
#-----------------------------------------------------------------------------
proc Help08 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help08"

if {$only}  {
  $win.ht1 configure -height 12
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Show Archives Only" bold
$win.ht1 insert end "\n      Toggles the file list view between displaying all files and displaying only files with commonly\
  recognized archive type extensions. An archive need not have a recognizable extension to be selected and viewed,\
  but this option limits the file list display to recognizable file names.\
  \n      This option has no effect when you enter the /dev directory. Instead the list is constrained to display only those\
  raw devices the program recognizes as commonly used archive devices, like rmt0, fd0, etc." normal 


return 1
}


#-----------------------------------------------------------------------------
#  Help 09  --  Explain Warn of Overwrites
#-----------------------------------------------------------------------------
proc Help09 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help09"

if {$only}  {
  $win.ht1 configure -height 8
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Warn of Overwrites" bold
$win.ht1 insert end "\n      When set, this causes a warning window to pop up whenever extracting a file would overwrite an\
  existing file. Setting this option unsets the \"Never Overwrite\" option. The two are mutually exclusive." normal 


return 1
}


#-----------------------------------------------------------------------------
#  Help 10  --  Explain Never Overwrite
#-----------------------------------------------------------------------------
proc Help10 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help10"

if {$only}  {
  $win.ht1 configure -height 10
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Never Overwrite Existing Files" bold
$win.ht1 insert end "\n      When set, extract quietly passes over any existing files that it would otherwise overwrite. Setting\
  this option unsets the \"Warn of Overwrites\" option.\n      This option is currently unconditional: there are no refinements\
  like \"only overwrite older/newer files.\" These niceties are for a future release." normal 


return 1
}


#-----------------------------------------------------------------------------
#  Help 11  --  Explain ITG
#-----------------------------------------------------------------------------
proc Help11 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help11"

if {$only}  {
  $win.ht1 configure -height 12
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Ignore Gnu \"trailing garbage\" Message" bold
$win.ht1 insert end "\n      Gnu gzip sometimes produces a message about \"ignoring trailing garbage\" when reading from a\
  device. Setting this option will cause $PgmName not to pop up a warning box when this occurs.\n      The option\
  makes no difference, operationally. It is purely cosmetic. The archive is perfectly usable in\
  either case, but the message sometimes alarms novices and annoys experienced users. This option is set on by default." normal 


return 1
}


#-----------------------------------------------------------------------------
#  Help 12  --  Explain Improved Tar Detection
#-----------------------------------------------------------------------------
proc Help12 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help12"

if {$only}  {
  $win.ht1 configure -height 8
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Improved Tar Detection" bold
$win.ht1 insert end "\n      Some brain-damaged Unices do not respond gracefully to $PgmName's method of identifying a\
  tar. If $PgmName fails to recognize tars, set this option to make it try extra hard. This option is set on by default." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 13  --  Explain Don't Probe
#-----------------------------------------------------------------------------
proc Help13 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help13"

if {$only}  {
  $win.ht1 configure -height 12
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Don't Probe Compressed Files" bold
$win.ht1 insert end "\n      By default, $PgmName will examine compressed files to see whether they contain a tar, and if so, will\
  open up the directory of the tar instead of showing you the contents of the compressed file. Unfortunately, this makes it a bit\
  awkward if all you want to do is uncompress the tar; in fact, you can't do it. Check this option to change that." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 14  --  Explain Save Options
#-----------------------------------------------------------------------------
proc Help14 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help14"

if {$only}  {
  $win.ht1 configure -height 8
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Save Options" bold
$win.ht1 insert end "\n      Clicking this button will cause various program options, including the present configuration of the\
  viewer list, to be written to the user's configuration file, \$Home/.$PgmName.rc. This file, if it exists, is read at startup to\
  override any default options." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 15  --  Explain Help
#-----------------------------------------------------------------------------
proc Help15 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help15"

if {$only}  {
  $win.ht1 configure -height 12
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n\nHelp        " big

Help16 $win 0
Help17 $win 0
Help18 $win 0
Help19 $win 0

return 1
}


#-----------------------------------------------------------------------------
#  Help 16  --  Explain Help About
#-----------------------------------------------------------------------------
proc Help16 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help16"

if {$only}  {
  $win.ht1 configure -height 6
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  About             " bold
$win.ht1 insert end "\n      The obligatory legalese. Pops up the first time you run $PgmName (or if you\
  delete \$Home/.$PgmName.rc)." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 17  --  Explain Help Help - isn't this going a bit far...?
#-----------------------------------------------------------------------------
proc Help17 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help17"

if {$only}  {
  $win.ht1 configure -height 4
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Help              " bold
$win.ht1 insert end "\n      How you got here." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 18  --  Explain Help Register
#-----------------------------------------------------------------------------
proc Help18 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help18"

if {$only}  {
  $win.ht1 configure -height 8
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Register $PgmName    " bold
$win.ht1 insert end "\n      Opens an entry window for entering a registration form. You may elect to send the completed form to the\
  author via Internet E-mail, or to save it as a text file. \n    " normal

return 1
}


#-----------------------------------------------------------------------------
#  Help 19  --  Explain Help Bug Report
#-----------------------------------------------------------------------------
proc Help19 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help19"

if {$only}  {
  $win.ht1 configure -height 8
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Bug Report/Comment    " bold
$win.ht1 insert end "\n      Opens an entry window for sending a bug report or comment to the author. \
  You may elect to send the completed form via Internet E-mail, or to save it as a text file to send via some other means. \n    " normal

return 1
}


#-----------------------------------------------------------------------------
#  Help 20  --  Explain Close button
#-----------------------------------------------------------------------------
proc Help20 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help20"

if {$only}  {
  $win.ht1 configure -height 6
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure big -font -*-Times-Bold-R-Normal--*-140-*-*-*-*-*-*

$win.ht1 insert end "\n\nClose        " big
$win.ht1 insert end "\n    Does just what you would expect it to. Closes the archive view." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 21  --  Explain Select All button
#-----------------------------------------------------------------------------
proc Help21 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help21"

if {$only}  {
  $win.ht1 configure -height 8
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure big -font -*-Times-Bold-R-Normal--*-140-*-*-*-*-*-*

$win.ht1 insert end "\n\nSelect All   " big
$win.ht1 insert end "\n    Do you really need to ask? Selects all files in the current archive. Actually, it toggles between\
  \"Select All\" and \"Deselect All\"." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 22  --  Explain View button
#-----------------------------------------------------------------------------
proc Help22 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help22"

if {$only}  {
  $win.ht1 configure -height 10
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure big -font -*-Times-Bold-R-Normal--*-140-*-*-*-*-*-*

$win.ht1 insert end "\n\nView         " big
$win.ht1 insert end "\n    Has the same effect as double-clicking an entry in the file list. Invokes an external viewing\
  program for the selected item. If more than one item in the list is selected, it will only spawn a viewer for the first\
  selected file." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 23  --  Explain Extract button
#-----------------------------------------------------------------------------
proc Help23 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help23"

if {$only}  {
  $win.ht1 configure -height 8
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure big -font -*-Times-Bold-R-Normal--*-140-*-*-*-*-*-*

$win.ht1 insert end "\n\nExtract      " big
$win.ht1 insert end "\n    Extracts all selected items from the archive. Opens a directory selection window for you to\
  choose the directory into which you wish to extract the files. " normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 24  --  Explain Add button
#-----------------------------------------------------------------------------
proc Help24 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help24"

if {$only}  {
  $win.ht1 configure -height 18
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure big -font -*-Times-Bold-R-Normal--*-140-*-*-*-*-*-*

$win.ht1 insert end "\n\nAdd          " big
$win.ht1 insert end "\n    Opens an Add Members dialogue to allow you to build a\
  selection list of files to add to the archive. Normally, this function is only\
  available for archive type files, which contain multiple members. You cannot\
  add \"members\" to simple compressed files: they don't have members.\
  \n    An exception to this rule is the creation of a new archive. In this case,\
  you are presented with a directory list of an \"empty\" archive or compressed file,\
  and the \"Add\" button should be the only button active. This allows you to select\
  one or more files, as appropriate, to archive or compress." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 25  --  Explain Delete button
#-----------------------------------------------------------------------------
proc Help25 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help25"

if {$only}  {
  $win.ht1 configure -height 8
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure big -font -*-Times-Bold-R-Normal--*-140-*-*-*-*-*-*

$win.ht1 insert end "\n\nDelete       " big
$win.ht1 insert end "\n    Deletes all selected items from the archive. This\
  function is only available for archive type files, which contain multiple members,\
  not for simple compressed files. " normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 26  --  Explain Select Viewer button
#-----------------------------------------------------------------------------
proc Help26 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help26"

if {$only}  {
  $win.ht1 configure -height 18
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure big -font -*-Times-Bold-R-Normal--*-140-*-*-*-*-*-*

$win.ht1 insert end "\n\nSelect Viewer" big
$win.ht1 insert end "\n    Presents a menu of some common viewing programs, and allows you to enter one of your own\
  choosing. The program must be able to accept a filename or list of filenames as a command line argument. You may\
  specify program options like \"-xyz\".\n      $PgmName will append the filename(s) at the end of the command line you\
  specify.\n      If you need something trickier, like \"-bMyFilename\", you can use the special variable symbol \"\$*\",\
  which will be replaced by the filename or list of names (for our example, the command you enter would look like\
  \"mypgm -b\$*\").\n    To add a viewer to the menu, click on the last\
  item (\"User defined\") and use the entry fields on the Archive Contents window to enter the name of the executable and\
  a descriptive name (which will appear on the menu). To delete an item, right-click (Button-3) on the item.\
  \n    Viewer list updates are global - they will be reflected in the viewer menus for all\
  open windows. Also, when you delete an entry, if any open windows had that viewer selected,\
  they will have their selections reset to the first entry in the updated list.\
  \n    Note that if you tear off this menu, it will not reflect updates made to the selection list from other\
  windows until you destroy the tear off and click the \"Select Viewer\" button again." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 27  --  Explain Warn on Viewer Delete
#-----------------------------------------------------------------------------
proc Help27 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help27"

if {$only}  {
  $win.ht1 configure -height 8
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Warn on Viewer Delete" bold
$win.ht1 insert end "\n      By default, an attempt to delete an item from the viewer menu (button-3 or \"right-button\"\
  click) will cause a confirmation request to pop up. Unchecking this option suppresses that." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 28  --  Explain Warn on Archive Delete
#-----------------------------------------------------------------------------
proc Help28 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help28"

if {$only}  {
  $win.ht1 configure -height 8
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Warn on Archive Delete" bold
$win.ht1 insert end "\n      By default, an attempt to delete an archive file altogether\
  will cause a confirmation request to pop up. Unchecking this option suppresses that." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 29  --  Explain Warn on Archive Member Delete
#-----------------------------------------------------------------------------
proc Help29 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help29"

if {$only}  {
  $win.ht1 configure -height 8
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Warn on Member Delete" bold
$win.ht1 insert end "\n      By default, an attempt to delete a member from an archive\
  will cause a confirmation request to pop up. Unchecking this option suppresses that." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 30  --  Explain Clean Old Directories
#-----------------------------------------------------------------------------
proc Help30 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help30"

if {$only}  {
  $win.ht1 configure -height 14
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Clean Old Temp Files" bold
$win.ht1 insert end "\n      If $PgmName terminates abnornally, temporary files may be left\
  in your home directory. If this option is set, $PgmName will check for these when it starts\
   up, and delete any that it finds. This option is set on by default.\
   \n      This is not 100% foolproof for a one-time shot, but usually catches them on the first\
   try. $PgmName uses a temp directory that contains the pid of the current process in its name. When it\
   searches for stale directories, it will ignore any containing the pid of an active process, which\
   might not be $PgmName (it doesn't assume that you haven't renamed $PgmName to something else, so it does not\
   try to match the program name of a running process)." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 31  --  Explain Clean Old Error Files
#-----------------------------------------------------------------------------
proc Help31 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help31"

if {$only}  {
  $win.ht1 configure -height 9
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Clean Old Error Files" bold
$win.ht1 insert end "\n      If $PgmName encounters certain errors - usually i/o errors reading or writing\
  an archive file - it may leave a copy of the error message(s) returned by the archive program in\
  your home directory, in a file with a name of the form TkzErrnnn-nn.\
  If this option is set, $PgmName will check for these when it starts\
  up, and delete any that it finds. This option is set on by default." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 32  --  Explain Don't Save Error Files
#-----------------------------------------------------------------------------
proc Help32 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help32"

if {$only}  {
  $win.ht1 configure -height 9
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Don't Save Error Files" bold
$win.ht1 insert end "\n      Instructs $PgmName not to save copies of error messages returned by\
  archive programs in your root directory. They can occasionally be useful in diagnosing a problem,\
  but often prove to be more of an annoyance than a help, so the option is set on by default." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 33  --  Explain Save Options on Exit
#-----------------------------------------------------------------------------
proc Help33 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help33"

if {$only}  {
  $win.ht1 configure -height 6
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  SaveOptions on Exit" bold
$win.ht1 insert end "\n      Instructs $PgmName to save the current options on exit. What did\
  you think it meant?" normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 34  --  Explain Standard Names
#-----------------------------------------------------------------------------
proc Help34 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help34"

if {$only}  {
  $win.ht1 configure -height 10
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Use Standard Name Extensions" bold
$win.ht1 insert end "\n      Instructs $PgmName to use the commonly accepted file name\
  extensions (\".tar.gz\", \".Z\", etc.) when creating a new archive. Recommended in most\
  cases, this option is set on by default.\n      In some cases, $PgmName will enforce\
  these conventions anyway, since the archive programs will force them." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 35  --  Explain GNU/Linux tgz convention
#-----------------------------------------------------------------------------
proc Help35 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help35"

if {$only}  {
  $win.ht1 configure -height 8
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  GNU/Linux tgz Convention" bold
$win.ht1 insert end "\n      Instructs $PgmName to use the GNU/Linux style of naming\
  gzipped tars, with an extension of \".tgz\" instead of \".tar.gz\". This option is set off by default." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 36  --  Try to explain the Shorten Heuristic
#-----------------------------------------------------------------------------
proc Help36 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help36"

if {$only}  {
  $win.ht1 configure -height 8
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Shorten Heuristic (experimental)" bold
$win.ht1 insert end "\n      Instructs $PgmName to try to analyze errors that occur when attempting\
  to create a shortened file, alter the program options accordingly, and try again." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 37  --  Try to explain Disable Colormap Hack
#-----------------------------------------------------------------------------
proc Help37 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help37"

if {$only}  {
  $win.ht1 configure -height 12
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Disable Colormap Hack" bold
$win.ht1 insert end "\n      $PgmName normally uses some colors that do not work well in a\
  dithered 256-color visual mode: some of the screens become virtually illegible. So, it\
  checks your current visual, and if it detects less than a 16-bit color mode, uses a reduced\
  set of colors.\n      Unfortunately, the original technique used was error-prone, and has been replaced\
  in release 0.7.0 with new code that has been little tested. So, the \"Disable Colormap Hack\" Hack\
  is provided temporarily to disable that behavior, should it cause problems." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 38  --  Explain Fast-Clean
#-----------------------------------------------------------------------------
proc Help38 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help38"

if {$only}  {
  $win.ht1 configure -height 12
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Fast-Clean View Files" bold
$win.ht1 insert end "\n      For viewing, $PgmName extracts a file to a temporary file, which is passed\
  to the external viewing program. With this option set, these files will be deleted as soon as you close the view\
  window from which they were selected. This may cause a problem with some 'viewers' -- say, for example, you\
  selected a sound clip or a MPEG to play, and then quickly close the archive window. This option is set off\
  by default for this reason.\n      Note that all temporary files will be deleted when you terminate $PgmName,\
  regardless of what external programs may have been invoked." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 39  --  Explain View Multiple Files
#-----------------------------------------------------------------------------
proc Help39 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help39"

if {$only}  {
  $win.ht1 configure -height 12
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  View Multiple Files" bold
$win.ht1 insert end "\n      $PgmName normally allows one file to be selected for viewing at one time.\
  If more than one file is selected, only the first one will be passed to the viewer program.\n      Setting\
  this option will allow the entire list of selected files to be passed to the viewer. The viewer must be able\
  to accept a list of file names on the command line. $PgmName has no way to verify this, so know the characteristics\
  of your viewer programs." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 40  --  Explain Compresson Options
#-----------------------------------------------------------------------------
proc Help40 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help40"

if {$only}  {
  $win.ht1 configure -height 13
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Compression Options" bold
$win.ht1 insert end "\n      Most compression programs have an option to let you adjust the balance\
  between speed and degree of compression. The options \"Max Speed\", \"Medium\", and \"Max Compression\"\
  select the lowest, middle, and highest compression settings, respectively, used by the various compression\
  utilities.\n      \"Default\" feeds no option to the program, and lets it take its default. For most uses,\
  the default is the best. Most programs slightly favor compression, and the additional processing overhead\
  used for maximum compression often yields disappointing decreases in the size of the resulting file." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 41  --  Explain Use Pathnames when Viewing
#-----------------------------------------------------------------------------
proc Help41 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help41"

if {$only}  {
  $win.ht1 configure -height 8
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Use Pathnames when Viewing" bold
$win.ht1 insert end "\n      When you invoke an external viewer program, $PgmName normally passes\
  the list of filenames to it with the path stripped off, since it invokes the program from the\
  directory where these temporary files reside. Some programs can't figure this out, so if you use\
  one of these, set this option on." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 42  --  Explain Cache Directory
#-----------------------------------------------------------------------------
proc Help42 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help42"

if {$only}  {
  $win.ht1 configure -height 12
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Change Cache Directory" bold
$win.ht1 insert end "\n      Allows you to set the directory where $PgmName builds its temporary cache directory. By default,\
   $PgmName builds it in your home directory. In most cases, you should trust the wisdom of this decision, and not mess with\
   this setting.\n      This option is provided for cases where your home directory resides on a file system that is getting\
   dangerously close to full. It allows you to change to a directory on a different file system with more free space. The\
   directory must already exist; and, obviously, it should be one to which no other users have write privileges.\n      When\
   you change this setting, the existing cache directory is removed. You must close any open archive windows before performing this\
   operation. \n      If you save your options, $PgmName will\
   continue using the new location the next time it starts; otherwise, it will revert to the previous location." normal 

return 1
}


#-----------------------------------------------------------------------------
#  Help 43  --  Explain Allow Extract of Directories
#-----------------------------------------------------------------------------
proc Help43 {win only}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
set thisproc "Help43"

if {$only}  {
  $win.ht1 configure -height 12
  }
$win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
$win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*

$win.ht1 insert end "\n  Allow Extract of Directories" bold
$win.ht1 insert end "\n      Ordinarily, $PgmName will ignore directory entries in the selected list of filenames to\
  extract. The philosophy is that if you selected specific files, you probably didn't intend to select the whole directory,\
  which is the effect of passing just the directory name to tar. However, this can occasionally cause a problem, so setting this\
  option on will cause $PgmName not to filter out directory entries.\n      If you have a tar that contains some empty directories\
  (i.e., a directory name entry but no files belonging to that directory), then that directory will not get created with $PgmName's\
  default handling. Occasionally you may run into a software package that depends on empty directories' being created, and their\
  make or install procedures will fail. In this case, you need to set this option on.\n      Unfortunately, this practice bumps heads\
  with an inelegant \"feechur\" of GNU tar, which gets confused if passed a list of filenames containing a directory name and then the\
  individual filenames in that directory. $PgmName will not use the list mode of GNU tar if this option is set, and extraction is much\
  slower. " normal 

return 1
}


#-----------------------------------------------------------------------------
#  SetHelp  --  A menu was Button-3-clicked - this will get driven before the
#      command implicitly bound to the menubutton, so indicate that this is
#      really a Help request. Whew!
#      Also, save the state of radio buttons, which aren't a simple toggle.
#      They haven't been touched yet, but they will be, maybe.
#-----------------------------------------------------------------------------
proc SetHelp {}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
global MenuHelp
global CompOpt ShCompOpt
set thisproc "SetHelp"

set ShCompOpt $CompOpt

set MenuHelp 1
return 1
}


#-------------------------------------------------------------------------------
#  UnSetHelp  --  A menu was Button-1-clicked - this will get driven before the
#      command implicitly bound to the menubutton, so in case a help request
#      was pending, make it not be so. This is needed because nothing really
#      gets bound to the cascade line, although the book says it does. Sheeeesh!
#-------------------------------------------------------------------------------
proc UnSetHelp {}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
global MenuHelp
set thisproc "UnSetHelp"

set MenuHelp 0
return 1
}

#-------------------------------------------------------------------------------
#  CheckHelp  --  A togglable menubutton was clicked - these can't be bound like 
#  normal widgets, but they can to a command. Hence the hack to see whether this
#      was a Button-1 or Button-3 click. If Help, we have to reset the option
#      flag - it got toggled no matter which button was clicked.
#-------------------------------------------------------------------------------
proc CheckHelp {context}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug
global MenuHelp IgnITG ShIgnITG Desperation ShDesperation NoProbe ShNoProbe
global VDWarn ADWarn MDWarn CldFlag CleFlag DseFlag SavOpt StdNames GnuLin 
global ShnHeur ColorHack FastClean MultView Vpn CompOpt ShCompOpt ExtDirs
set thisproc "CheckHelp"

switch $context    {

    11       {
        if {$MenuHelp}  {
          set MenuHelp 0
          set IgnITG $ShIgnITG
          ShowHelp 11
          }  else  {
          set ShIgnITG $IgnITG
          }
        }
    12       {
        if {$MenuHelp}  {
          set MenuHelp 0
          set Desperation $ShDesperation
          ShowHelp 12
          }  else  {
          set ShDesperation $Desperation
          }
        }
    13       {
        if {$MenuHelp}  {
          set MenuHelp 0
          set NoProbe $ShNoProbe
          ShowHelp 13
          }  else  {
          set ShNoProbe $NoProbe
          }
        }
    27       {
        if {$MenuHelp}  {
          set MenuHelp 0
          set VDWarn [ToggleOpt "$VDWarn"]
          ShowHelp 27
          }
        }
    28       {
        if {$MenuHelp}  {
          set MenuHelp 0
          set ADWarn [ToggleOpt "$ADWarn"]
          ShowHelp 28
          }
        }
    29       {
        if {$MenuHelp}  {
          set MenuHelp 0
          set MDWarn [ToggleOpt "$MDWarn"]
          ShowHelp 29
          }
        }
    30       {
        if {$MenuHelp}  {
          set MenuHelp 0
          set CldFlag [ToggleOpt "$CldFlag"]
          ShowHelp 30
          }
        }
    31       {
        if {$MenuHelp}  {
          set MenuHelp 0
          set CleFlag [ToggleOpt "$CleFlag"]
          ShowHelp 31
          }
        }
    32       {
        if {$MenuHelp}  {
          set MenuHelp 0
          set DseFlag [ToggleOpt "$DseFlag"]
          ShowHelp 32
          }
        }
    33       {
        if {$MenuHelp}  {
          set MenuHelp 0
          set SavOpt [ToggleOpt "$SavOpt"]
          ShowHelp 33
          }
        }
    34       {
        if {$MenuHelp}  {
          set MenuHelp 0
          set StdNames [ToggleOpt "$StdNames"]
          ShowHelp 34
          }
        }
    35       {
        if {$MenuHelp}  {
          set MenuHelp 0
          set GnuLin [ToggleOpt "$GnuLin"]
          ShowHelp 35
          }
        }
    36       {
        if {$MenuHelp}  {
          set MenuHelp 0
          set ShnHeur [ToggleOpt "$ShnHeur"]
          ShowHelp 36
          }
        }
    37       {
        if {$MenuHelp}  {
          set MenuHelp 0
          set ColorHack [ToggleOpt "$ColorHack"]
          ShowHelp 37
          }
        }
    38       {
        if {$MenuHelp}  {
          set MenuHelp 0
          set FastClean [ToggleOpt "$FastClean"]
          ShowHelp 38
          }
        }
    39       {
        if {$MenuHelp}  {
          set MenuHelp 0
          set MultView [ToggleOpt "$MultView"]
          ShowHelp 39
          }
        }
    40       {
        if {$MenuHelp}  {
          set MenuHelp 0
          set CompOpt $ShCompOpt
          ShowHelp 40
          }
        }
    41       {
        if {$MenuHelp}  {
          set MenuHelp 0
          set Vpn [ToggleOpt "$Vpn"]
          ShowHelp 41
          }
        }
    43       {
        if {$MenuHelp}  {
          set MenuHelp 0
          set ExtDirs [ToggleOpt "$ExtDirs"]
          ShowHelp 43
          }
        }
    default       {
        if {$MenuHelp}  {
#puts "CheckHelp 99!"
          set MenuHelp 0
          }
        }
    }

return 1
}


#-----------------------------------------------------------------------------
#  Help About  --  The legalese, etc.
#-----------------------------------------------------------------------------
proc About {}  {
global WhoBg MainButBg MainBg PgmName TkzVer Debug MenuHelp

if {$MenuHelp}  {
  set MenuHelp 0
  ShowHelp 16
  return 1
  }

#set hbg "FloralWhite"
set hbg "linen"
set win ".about"
set wintitle "About $PgmName"

		if [catch {toplevel $win} rc]  {
		  raise $win
		  }  else  {
		  # Define our widgets
		  wm title $win $wintitle
		  text $win.ht1
		  scrollbar $win.sby
		  frame $win.f2
		  set cmd "destroy $win"
		  button $win.f2.hb1 -text "Ok" -bg $MainButBg -command $cmd
		  # Tell the window mgr how to put 'em together
		  pack $win.f2.hb1
		  pack $win.f2 -side top -fill x
		  pack $win.sby -side right -fill y
		  pack $win.ht1 -fill both -expand yes

		  # Now set up the text
		  # Define some styles
		  $win.ht1 tag configure normal -font -*-*-*-R-Normal-*-*-120-*-*-*-*-*-*
		  $win.ht1 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*
		  $win.ht1 tag configure big -font -*-Times-Bold-R-Normal--*-140-*-*-*-*-*-*
		  $win.ht1 tag configure reallybig -font -*-Times-Bold-R-Normal--*-180-*-*-*-*-*-*
		  $win.ht1 tag configure cbig -font -*-Times-Bold-R-Normal--*-140-*-*-*-*-*-* -justify center
		  $win.ht1 tag configure creallybig -font -*-Times-Bold-R-Normal--*-180-*-*-*-*-*-* -justify center
		  $win.ht1 tag configure center -justify center
		  $win.ht1 tag configure heading -font -*-Times-Bold-R-Normal--*-240-*-*-*-*-*-* -justify center
		  $win.ht1 tag configure raised -relief raised -borderwidth 3
		  $win.ht1 tag configure hilite -foreground red
#		  $win.ht1 tag configure italic -font -*-Lucidabright-*-I-Normal--*-120-*-*-*-*-*-*
		  $win.ht1 tag configure italic -font -*-*-Medium-O-Normal-*-*-120-*-*-*-*-*-*
		  $win.ht1 tag configure italic2 -font -*-*-Bold-O-Normal-*-*-120-*-*-*-*-*-*

		  $win.ht1 insert end "\nAbout $PgmName\n\n" heading

    		  set text "    $PgmName   Copyright  1996, 1997 by Robert Woodside.\
		    \n\n    $PgmName version $TkzVer is a pre-release beta version. It is\
		    provided as is, without any warranty. While\
		    reasonable efforts have been made to insure that it is stable, some beta\
                    releases may contain functions that behave strangely or are downright broken.\
                    If I know about them, they will be documented on the TkZip Web pages\
                    (http://www.pcnet.com/~proteus/TkZip/TkZip.html).\n"
		  $win.ht1 insert end "$text" italic

		  $win.ht1 insert end "\nLegalese\n" creallybig

                  set text "\n    This program is copyrighted shareware. This is an unlicensed,\
                    freely distributable copy of $PgmName version $TkzVer.\
                    Permission to use, copy, and distribute this software\
                    and its documentation  for  any  non-commercial purpose  and without\
                    fee is hereby granted, provided that this copyright and permission\
                    notice appear in all copies of the program and its supporting\
                    documentation. Modification for personal use is also permitted. \n"
		  $win.ht1 insert end "$text" normal

                  set text "\n    Non-commercial use is interpreted fairly liberally. If you wish to\
                    install your personal copy on your workstation at work, this qualifies as non-commercial.\
                    If you are a sysadmin wishing to make it globally available at your site as an\
                    unsupported tool, that's fine too. If you wish to redistribute it as part of a package for\
                    which you charge a fee, except as noted below, that qualifies as commercial use, and requires\
                    a license from the copyright holder. If you're a sysadmin wishing to make it a formally\
                    supported tool for your users, you need to contact me about licensing. If you are in doubt,\
                    contact me.\n"
		  $win.ht1 insert end "$text" normal

                  set text "\n    Distributors of Linux, commercial or otherwise, and regardless of medium,\
                    are specifically exempted from the non-commercial restriction above with\
                    respect to inclusion of an unregistered copy of TkZip with their Linux\
                    distributions, so long as the code is not modified and is sourced from an\
                    authorized repository (like this one), and the author is duly notified of\
                    such distribution. Additionally, distributions sourced from a standard public ftp site,\
                    such as Sunsite or any of its mirrors, incur no obligation to notify the\
                    author.\n"
		  $win.ht1 insert end "$text" normal

                  set text "\n    Robert Woodside and Woodsway Consulting disclaim all express\
                    or implied warranties with regard to this software, including, but not\
                    limited to, warranties of merchantability or fitness for any particular\
                    purpose. In no event shall Robert Woodside or Woodsway Consulting be held\
                    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 tortious action, arising from or in\
                    connection with the use or performance of this software.\n"
		  $win.ht1 insert end "$text" italic2


		  # Set the other attributes

		  set ycmd "$win.sby set"
		  $win.ht1 configure -bg $hbg -wrap word -state disabled \
		    -yscroll $ycmd 
		  $win.f2 configure -bg RosyBrown
		  set ycmd "$win.ht1 yview"
		  $win.sby configure -command $ycmd


                  }


return 1
}


#-----------------------------------------------------------------------------
#  Register  --  Send a registration form, bug report, or comment
#-----------------------------------------------------------------------------
proc Register {context}  {
global WhoBg MainButBg MainBg OsName OsVer PgmName TkzVer AuthEmail Debug
global WhoIAm WhereIAm rname raddr1 raddr2 raddr3 rphone ros rcomments
global EmUser EmHost
global BugOpt MenuHelp




set thisproc "Register"
#set rgbg "FloralWhite"
set rgbg "linen"
set wn "reg"
set win ".$wn"
set what "what$wn"
global $what
if {$context == 1}  {
  if {$MenuHelp}  {
    set MenuHelp 0
    ShowHelp 18
    return 1
    }
  set wintitle "Register $PgmName"
  set $what "Registration"
  }  else  {
  if {$MenuHelp}  {
    set MenuHelp 0
    ShowHelp 19
    return 1
    }
  set wintitle "$PgmName Bug-Report/Comment"
  set BugOpt 1
  set $what "Bug-Report"
  }

		if [catch {toplevel $win} rc]  {
		  raise $win
		  }  else  {

		  wm title $win $wintitle
		  wm iconname $win $wintitle

set euser $EmUser
set ehost $EmHost
set rname ""
set raddr1 ""
set raddr2 ""
set raddr3 ""
set rphone ""
set ros "$OsName $OsVer"
set rcomments ""


label $win.msg -wraplength 6i -justify left -bg $WhoBg

pack $win.msg -side top

$win configure -bg $MainButBg
frame $win.buttons -bg $MainButBg
pack $win.buttons -side bottom -fill x -pady 2m
button $win.buttons.dismiss -text Dismiss -command "destroy $win"
button $win.buttons.send -width 23
button $win.buttons.file -text "Save as File"

pack $win.buttons.dismiss $win.buttons.send $win.buttons.file -side left -expand 1

foreach i {e1 e2 e3 r1 r2 r3 r4 r5 r6} {
    frame $win.$i -bd 2 -bg $MainButBg
    entry $win.$i.entry -relief sunken -width 50
    label $win.$i.label -width 14 -bg $MainButBg
#    pack $win.$i.entry -side right
    pack $win.$i.label $win.$i.entry -side left
}

frame $win.t -bg $MainButBg
label $win.t.l -width 14 -bg $MainButBg 


switch    $context  {
    1    {
      $win.msg configure \
        -text "\n    This will E-mail a \"registration\" form\
          for the pre-release beta of $PgmName to the author at $AuthEmail.\
          \n    This is not an official shareware registration, since this is beta code. It costs\
          nothing. No salesman will call. Its purpose is to\
          give the author some feedback on how many people are interested in using $PgmName. However,\
          beta \"registrants\" will have a major influence on the quality of the finished product, and are actively\
          solicited for comments regarding the program's usefulness, usability, and stability.\
          \n    NOTE: if your Internet connection is via an ISP, please enter your real Internet e-mail\
          address below. I can't reply to 'sillyme@bogus.domain.com'.\n"
      $win.buttons.send configure -text "E-mail the Registration Form"
      $win.t.l configure -text "Comments: "
      }
    2    {
      $win.msg configure \
        -text "\n    The preferred method of submitting a bug report or general comment is to use this form to E-mail it\
          to the author at $AuthEmail, or to save it as a file to mail later.\
          \n    NOTE: if your Internet connection is via an ISP, please enter your real Internet e-mail\
          address below. I can't reply to 'sillyme@bogus.domain.com'.\n"
      $win.buttons.send configure -text "E-mail the Bug Report"
      $win.t.l configure -text "Description: "
      

      }
    }


text $win.t.t -bg $WhoBg -height 10 -width 50 -wrap word
pack $win.t.l $win.t.t -side left

$win.e1.label configure -text "User:"
$win.e1.entry configure -textvariable EmUser
$win.e2.label configure -text "@Host:"
$win.e2.entry configure -textvariable EmHost
$win.r1.label configure -text "Name:"
$win.r1.entry config -textvariable rname
$win.r2.label configure -text "Address:"
$win.r1.entry config -textvariable raddr1
$win.r1.entry config -textvariable raddr2
$win.r1.entry config -textvariable raddr3
$win.r5.label configure -text "Phone:"
$win.r5.entry config -textvariable rphone
$win.r6.label configure -text "OS Version:"
$win.r6.entry config -textvariable ros
if {$context == 1}  {
  pack $win.msg $win.e1 $win.e2 $win.r1 $win.r2 $win.r3 $win.r4 $win.r5 $win.r6 $win.t -side top -fill x
  }  else  {
  frame $win.brcf -bg $MainButBg
  button $win.brcf.brb -width 10 -text "Bug/Comment"
#  button $win.brcf.cb -width 10 -text "Comment " 
  label $win.brtag -bg $MainButBg -text "Bug Report" -font "-*-*-Bold-*-*-*-*-160-*-*-*-*-*-*"

  pack $win.msg $win.e1 $win.e2 $win.r1 $win.r2 $win.r3 $win.r4 $win.r5 $win.r6 -side top -fill x
  pack $win.brtag -anchor center
  pack $win.brcf.brb -side top
  pack $win.t $win.brcf -side left -fill x
  set cmd "ToggleRept $wn"
  bind $win.brcf.brb <Button-1> $cmd
#  set cmd "Comment $wn"
#  bind $win.brcf.cb <Button-1> $cmd
  }


set cmd "SendReg $wn 1 $context"
bind $win.buttons.send <Button-1> $cmd
set cmd "SendReg $wn 2 $context"
bind $win.buttons.file <Button-1> $cmd
focus $win.e1.entry

tkwait window $win

if {$EmUser != $euser || $EmHost != $ehost}  {
  SaveConfig
  }


		  }
return 1
}

proc ToggleRept {wn}  {
global BugOpt

set BugOpt [ToggleOpt $BugOpt] 
if {$BugOpt}  {
  BugRpt "$wn"
  }  else  {   
  Comment "$wn"
  }
return 1
}

proc BugRpt {wn}  {
set what "what$wn"
global $what
set $what "Bug-Report"
.$wn.brtag configure -text "Bug-Report"
#.$wn.brtag configure -text "     Bug-Report        "
.$wn.buttons.send configure -text "E-mail the Bug Report"
.$wn.t.l configure -text "Description: "
return 1
}

proc Comment {wn}  {
set what "what$wn"
global $what
set $what "Comment"
.$wn.brtag configure -text "Just a Comment"
.$wn.buttons.send configure -text "E-mail Your Comments"
.$wn.t.l configure -text "Comments: "
return 1
}

proc SendReg {wn func context}  {
global WhoBg MainButBg MainBg Home TempDir PgmName TkzVer AuthEmail ErrArgs Debug
global WhoIAm WhereIAm Timehdr EmUser EmHost rname raddr1 raddr2 raddr3 rphone ros rcomments

set owner ".$wn"
set whatisit "what$wn"
global $whatisit
set mailer "/bin/mail"
if { ! [file exists $mailer] }  {
  set mailer "/bin/Mail"
  if { ! [file exists $mailer] }  {
    set mailer ""
    }
  }
if {$context == 1}  {
  set fn "$Home/$PgmName-$TkzVer-Registration.txt"
  set subj "Register $PgmName $TkzVer to $EmUser@$EmHost"
  set msghd "\n        Registration Request for $PgmName $TkzVer\n"
  set what "Registration"
  }  else  {
  set what [ set $whatisit ]
  set fn "$Home/$PgmName-$TkzVer-$what.txt"
  set subj "$what $PgmName $TkzVer from $EmUser@$EmHost"
  set msghd "\n           $what for $PgmName $TkzVer\n"
  }

set EmUser [ $owner.e1.entry get ]
set EmHost [ $owner.e2.entry get ]
set rname [ $owner.r1.entry get ]
set raddr1 [ $owner.r2.entry get ]
set raddr2 [ $owner.r3.entry get ]
set raddr3 [ $owner.r4.entry get ]
set rphone [ $owner.r5.entry get ]
set ros [ $owner.r6.entry get ]
set comments [ $owner.t.t get 1.0 end]
set sysinfo "$TempDir/TkzSysinfo"
set sinf ""
catch {set si [open $sysinfo r]}
while  { [ gets $si line ] > -1 } {
  set sinf "$sinf\n$line"
  }
catch {close $si}


#set subj "Register $PgmName $TkzVer to $EmUser@$EmHost"
set msg "$msghd \
  \nName:       $rname \
  \nAddress:    $raddr1 \
  \n            $raddr2 \
  \n            $raddr3 \
  \nPhone:      $rphone \
  \nUser id:    $EmUser \
  \nHost:       $EmHost \
  \nOS Version: $ros \
  \nDate/Time:  $Timehdr \
  \n\n\nComments: \
  \n\n$comments \
  \n\n\n\nAdditional System Information: \
  \n\n$sinf"

if {$EmUser == ""}  {
  set ErrArgs "$what"
  GErrMsgBox 5
  return -1
  }
if {$EmHost == ""}  {
  set ErrArgs "$what"
  GErrMsgBox 5
  return -1
  }

switch      $func  {
	1    {
          if {$mailer == ""}  {
            set ErrArgs "$AuthEmail $what"
            GErrMsgBox 13
            return -1
            }
	  set rc [catch {exec echo $msg | $mailer -s "$subj" $AuthEmail} cc]
	  if {$rc == 0}  {
	    set ErrArgs "$AuthEmail $what"
	    GErrMsgBox 10
	    }  else  {
	    set ErrArgs "$AuthEmail $what"
	    GErrMsgBox 11
	    }
	  }
	2    {
#	  set rc [catch {exec echo $msg > $fn} cc]
          catch {set fi [open $fn w]}
          catch {puts $fi $msg}
	  catch {close $fi}
	  set ErrArgs "$fn $what"
	  GErrMsgBox 9
	  }
	}


return 1
}

#-----------------------------------------------------------------------------
#  ShowSysInfo  --  Tell a little about the environment 
#-----------------------------------------------------------------------------
proc ShowSysInfo {}  {
global PgmName TkzVer TkzDate NeededPgms GotPgmFlags NeededPgmFlags
global NeededPgms2 GotPgmFlags2 NeededPgmFlags2
global OsName OsVer TclVer TkVer MyPid Debug MenuHelp

if {$MenuHelp}  {
  set MenuHelp 0
  ShowHelp 06
  return 1
  }

set thisproc "ShowSysInfo"
set sibg "MediumSpringGreen"
set wn "sinfo"
set win ".$wn"
set wintitle "SysInfo"
set mailer "/bin/mail"
if { ! [file exists $mailer] }  {
  set mailer "/bin/Mail"
  if { ! [file exists $mailer] }  {
    set mailer ""
    }
  }

if [catch {toplevel $win} rc]  {
  raise $win
  }  else  {
  wm title $win $wintitle
  wm iconname $win $wintitle

$win configure -bg $sibg
set cmd "KillSysinfo $win"
button $win.b1 -text "OK" -command $cmd

set arc $win.f1
set arc2 $win.f2
frame $arc -bg $sibg
frame $arc2 -bg $sibg
label $arc.l1 -text "\nArchive Programs" -bg $sibg -font "-*-Times-Bold-R-*-*-*-180-*-*-*-*-*-*" 
text $arc.l2 -width 40 -height 4 -relief flat -bg $sibg  -highlightbackground $sibg -wrap word
$arc.l2 insert end "    Checked programs appear to be present and functioning compatibly with $PgmName. \
  Programs that are unchecked either couldn't be found on your system, or don't respond in a way that is\
  compatible with this release of $PgmName."
$arc.l2 configure -state disabled
pack $arc.l1 $arc.l2 -side top -fill x -expand no

set i 0
while {[lindex $NeededPgms $i] != ""}  {
  set pgm [lindex $NeededPgms $i]
  checkbutton $arc.$i -width 12 -bg $sibg -highlightbackground $sibg -text $pgm \
  -disabledforeground Black 
  pack $arc.$i -side left -fill x -expand yes

  set flag [lindex $NeededPgmFlags $i]
  global $flag
  $arc.$i configure -variable $flag
  if {$Debug}  {
    $arc.$i configure -state normal
    }  else  {
    $arc.$i configure -state disabled
    }
  incr i
  }

set i 0
while {[lindex $NeededPgms2 $i] != ""}  {
  set pgm [lindex $NeededPgms2 $i]
  checkbutton $arc2.$i -width 12 -bg $sibg -highlightbackground $sibg -text $pgm \
  -disabledforeground Black 
  pack $arc2.$i -side left -fill x -expand yes

  set flag [lindex $NeededPgmFlags2 $i]
  global $flag
  $arc2.$i configure -variable $flag
  if {$Debug}  {
    $arc2.$i configure -state normal
    }  else  {
    $arc2.$i configure -state disabled
    }
  incr i
  }

set topf $win.topf
frame $topf -bg $sibg
set gen "$topf.f2"
frame $gen -bg $sibg
label $gen.l1 -text "\nGeneral" -bg $sibg -font "-*-Times-Bold-R-*-*-*-180-*-*-*-*-*-*" 
frame $gen.f1 -bd 2 -bg $sibg
label $gen.f1.l2 -bg $sibg -justify left -text "OS Version:      "
label $gen.f1.l3 -bg $sibg -justify left -text "$OsName  $OsVer"
frame $gen.f2 -bg $sibg
label $gen.f2.l4 -bg $sibg -justify left -text "Tcl/Tk Version:  "
label $gen.f2.l5 -bg $sibg -justify left -text "$TclVer/$TkVer"
frame $gen.f3 -bg $sibg
label $gen.f3.l6 -bg $sibg -justify left -text "Pid:  "
label $gen.f3.l7 -bg $sibg -justify left -text "$MyPid"
 
pack $gen.l1 -side top -fill x
pack $gen.f1.l2 $gen.f1.l3 -side left -expand no -fill none
pack $gen.f2.l4 $gen.f2.l5 -side left -fill none -expand no
pack $gen.f3.l6 $gen.f3.l7 -side left -fill none -expand no
pack $gen.f1 $gen.f2 $gen.f3 -side top -fill none -expand no -anchor w

set tkz "$topf.f3"
frame $tkz -bg $sibg
label $tkz.l1 -text "\n$PgmName" -bg $sibg -font "-*-Times-Bold-R-*-*-*-180-*-*-*-*-*-*" 
frame $tkz.f1 -bd 2 -bg $sibg
label $tkz.f1.l1 -bg $sibg -justify left -text "$PgmName Version:  "
label $tkz.f1.l2 -bg $sibg -justify left -text "$TkzVer"
frame $tkz.f2 -bd 2 -bg $sibg
label $tkz.f2.l1 -bg $sibg -justify left -text "Build Date:        "
label $tkz.f2.l2 -bg $sibg -justify left -text "$TkzDate"
pack $tkz.l1 -side top -fill x
pack $tkz.f1.l1 $tkz.f1.l2 -side left -expand no -fill none -anchor w
pack $tkz.f2.l1 $tkz.f2.l2 -side left -expand no -fill none -anchor w
pack $tkz.f1 $tkz.f2 -side top -fill none -expand no -anchor w

set mailf "$win.f4"
frame $mailf -bg $sibg
if {$mailer == ""}  {
  set canwe "cannot"
  set mailer "Not Found"
  }  else  {
  set canwe "can"
  set mailer "Found    ($mailer)"
  }
label $mailf.l1 -text "\nMail Capability" -bg $sibg -font "-*-Times-Bold-R-*-*-*-180-*-*-*-*-*-*" 
text $mailf.l2 -width 40 -height 4 -relief flat -bg $sibg  -highlightbackground $sibg -wrap word
$mailf.l2 tag configure bold -font -*-*-Bold-O-Normal--*-120-*-*-*-*-*-*
$mailf.l2 insert end "    $PgmName uses a very basic technique to send Bug Reports and Registration\
  Forms to the Author, and depends on your having a standard AT&T style mail command available on\
  your system. $PgmName believes that it "
$mailf.l2 insert end "$canwe " bold
$mailf.l2 insert end "send mail this way."
label $mailf.l3 -bg $sibg -text "Mailer:              $mailer"
$mailf.l2 configure -state disabled
pack $mailf.l1 -side top -fill x -expand no 
pack $mailf.l2 -side top -fill x -expand no
pack $mailf.l3 -side top -fill x -expand yes


pack $win.b1 
#pack $win.l1 -side top -fill x
#pack $win.l2 -side top -fill both -expand no 
#pack $win.f1 -side top -fill x -expand no
pack $gen -side left 
pack $tkz -side right
#pack $gen $tkz -side left -fill x -anchor center
pack $topf -side top -fill x 

#pack $arc.l1 -side left -fill x
#pack $arc.l2 -side top -fill both -expand no 
pack $arc -side top -fill x
pack $arc2 -side top -fill x

pack $mailf -side top -fill x -expand yes



  }


return 1
}

#------------------------------------------------------
#  KillSysInfo  --  in case any special cleanup needed 
#------------------------------------------------------
proc KillSysinfo {win}  {

destroy $win
return 1
}

#------------------------------------------------------
#  DeBug  --   Interactive display or logging
#------------------------------------------------------
proc DeBug {owner msg}  {
global ErrArgs Debugi Debugl Home

set dblog "$Home/TkzDebuglog"
if {$Debugi}  {
  if {$Debugl}  {
    catch {set db [open $dblog a+]}
    catch {puts $db "$msg"}
    catch [close $db]
    }
  set ErrArgs "$msg"
  set rc [GModMsgBox $owner 102]
  return $rc
  }  else  {
  if {$Debugl}  {
    catch {set db [open $dblog a+]}
    catch {puts $db "$msg"}
    catch [close $db]
    }
  }
return 1
}




#------------------------------
# Here's the real program...
#   Not very impressive, huh?
#------------------------------

Init
BuildMainFrame
# If cmd line arg specified a file, open up a window for it.
if {$InitFile != ""} {
  update idletasks
  DispArc $CurDir $InitFile 0 0
  }
if {$InitFlag}  {
  update idletasks
  About
  }

# Thatz all, folks!

