#
# hfsutils - tools for reading and writing Macintosh HFS volumes
# Copyright (C) 1996-1998 Robert Leslie
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# $Id: xhfs.tcl,v 1.8 1998/04/11 08:27:01 rob Exp $
#

set tk_strictMotif 1

set gNormalFont	{-adobe-helvetica-bold-r-normal-*-*-120-*-*-p-*-iso8859-1}
set gThinFont	{-adobe-helvetica-medium-r-normal-*-*-120-*-*-p-*-iso8859-1}
set gSmallFont	{-adobe-helvetica-medium-r-normal-*-*-100-*-*-p-*-iso8859-1}
set gTypeFont	{-*-lucidatypewriter-medium-r-normal-*-*-120-*-*-m-*-iso8859-1}
set gTitleFont	{-*-lucida-bold-i-normal-*-*-250-*-*-p-*-iso8859-1}

set gDefaultDevice	/dev/fd0
set gLowFormatCmd	[list fdformat $gDefaultDevice]
set gMountSide		.l
set gFlushInterval	30000
set gDfCmd		[list df]

option add *Font $gNormalFont

###############################################################################

# Set architecture defaults

if {[catch {exec uname} gUname] == 0} {
    switch $gUname {
	SunOS {
	    if {[catch {exec uname -r} gUrelease] == 0} {
		switch -glob $gUrelease {
		    4.* {
			set gLowFormatCmd [list fdformat -f /dev/rfd0]
		    }
		    5.* {
			set gDefaultDevice /vol/dev/aliases/floppy0
			set gLowFormatCmd [list fdformat -f $gDefaultDevice]
			set gDfCmd [list df -k]
		    }
		}
	    }
	}

	FreeBSD {
	    set gDefaultDevice /dev/rfd0
	    set gLowFormatCmd [list fdformat $gDefaultDevice]
	}
    }
}

###############################################################################

set gUnique 0

proc unique {} {
    global gUnique

    return [incr gUnique]
}

proc window {title iconname} {
    set w ".w[unique]"

    toplevel $w -cursor left_ptr -relief raised -bd 1
    wm title $w $title
    wm iconname $w $iconname
    wm transient $w .

    wm withdraw $w

    return $w
}

proc showwindow {w} {
    update idletasks

    set x [expr [winfo x .] + [winfo width  .]/2 - [winfo reqwidth  $w]/2]
    set y [expr [winfo y .] + [winfo height .]/3 - [winfo reqheight $w]/3]

    wm geom $w +$x+$y
    wm deiconify $w
}

proc dialog {title cancel {ok ""} {default 0}} {
    set w ".d[unique]"

    toplevel $w -class Dialog -cursor left_ptr
    wm title $w $title
    wm transient $w .

    wm withdraw $w

    frame $w.top -relief raised -bd 1
    frame $w.bot -relief raised -bd 1
    pack $w.top -side top -expand 1 -fill both -ipadx 4m -ipady 4m
    pack $w.bot -side bottom -fill both -ipadx 2m -ipady 2m

    frame $w.bot.default -relief sunken -bd 1

    button $w.bot.cancel -width 6 -text $cancel  \
	    -command "set gAnswer 0; [list destroy $w]"
    if {[string length $ok] > 0} {
	button $w.bot.ok -width 6 -text $ok  \
		-command "set gAnswer 1; [list destroy $w]"
    }

    if {$default} {
	pack $w.bot.cancel -side left -expand 1;# -ipadx 2m -ipady 1m
	pack $w.bot.default -side left -expand 1 -ipadx 1m -ipady 1m
	pack $w.bot.ok -in $w.bot.default -expand 1;# -ipadx 2m -ipady 1m
	bind $w <Key-Return> [list $w.bot.ok invoke]
    } else {
	pack $w.bot.default -side left -expand 1 -ipadx 1m -ipady 1m
	pack $w.bot.cancel -in $w.bot.default -expand 1;# -ipadx 2m -ipady 1m
	if {[string length $ok] > 0} {
	    pack $w.bot.ok -side left -expand 1;# -ipadx 2m -ipady 1m
	}
	bind $w <Key-Return> [list $w.bot.cancel invoke]
    }

    return $w
}

proc showdialog {w} {
    showwindow $w
    grab set $w
}

proc alert {kind title text {aspect 100}} {
    global gThinFont

    set w [dialog $title "OK"]

    frame $w.top.x
    label $w.top.x.icon -bitmap $kind -anchor n
    frame $w.top.x.space -width 2m
    message $w.top.x.msg -aspect $aspect -font $gThinFont -text $text
    pack $w.top.x.icon $w.top.x.space $w.top.x.msg -side left -fill y

    pack $w.top.x -expand 1

    showdialog $w
    tkwait window $w
}

proc bgerror {error} {
    alert stop "Error" "Sorry, $error." 1000
    return -code break
}

proc fixtext {text} {
    regsub -all "(\[^\n])\n\[ \t]*(\[^\n])" $text {\1 \2} text
    regsub -all "(^|\n)\[ \t]+" $text {\1} text
    regsub "\n*\$" $text "" text

    return $text
}

proc copy_ufs_to_hfs {srcvol name mode dstvol} {
    $dstvol copyin $mode "[$srcvol cwd]/$name" :
}

proc copy_hfs_to_ufs {srcvol name mode dstvol} {
    $srcvol copyout $mode $name "[$dstvol cwd]/."
}

proc copy_hfs_to_hfs {srcvol name mode dstvol} {
    $srcvol copy $name $dstvol :
}

proc copy_ufs_to_ufs {srcvol name mode dstvol} {
    $srcvol copy $name "[$dstvol cwd]/."
}

proc copy_directory {srcvol name dstvol copyproc modeproc} {
    global gXMode

    set srccwd [abspath [$srcvol sepchar] [$srcvol path]]
    set dstcwd [abspath [$dstvol sepchar] [$dstvol path]]

    $dstvol mkdir $name
    $srcvol chdir $name
    $dstvol chdir $name

    foreach ind [$srcvol dir] {
	array set item $ind

	if {$item(kind) == "directory"} {
	    copy_directory $srcvol $item(name) $dstvol $copyproc $modeproc
	} else {
	    if {$gXMode == "auto"} {
		set mode [$modeproc $srcvol item]
	    } else {
		set mode $gXMode
	    }

	    $copyproc $srcvol $item(name) $mode $dstvol
	}
    }

    $srcvol chdir $srccwd
    $dstvol chdir $dstcwd
}

proc delete_directory {vol name} {
    set cwd [abspath [$vol sepchar] [$vol path]]

    $vol chdir $name

    foreach ind [$vol dir] {
	array set item $ind

	if {$item(kind) == "directory"} {
	    delete_directory $vol $item(name)
	} else {
	    $vol delete $item(name)
	}
    }

    $vol chdir $cwd
    $vol rmdir $name
}

proc do_open {side} {
    set box $side.mid.lb
    set sel [$box curselection]
    set ind [lindex $sel 0]

    global vol

    set name [$box get $ind]
    if {[regexp "(.*)[$vol($side) sepchar]\$" $name ignore name]} {
	mchdir $side $name
    } else {
	show_file $side $name
    }
}

proc do_copy {side other} {
    set box $side.mid.lb
    set sel [$box curselection]

    global gXMode gAskDelete gAnswer
    global fstype dir vol

    if {$side == ".l"} {
	set other ".r"
    } else {
	set other ".l"
    }

    set needupdate 0

    foreach ind $sel {
	array set item [lindex $dir($side) $ind]

	$box see $ind

	# if {$gAskDelete && [catch {$vol($other) stat $item(name)}] == 0} {
	    # set w [dialog "Overwrite" "Cancel" "OK"]

	    # frame $w.top.x
	    # label $w.top.x.icon -bitmap caution -anchor n
	    # frame $w.top.x.space -width 2m
	    # message $w.top.x.msg -font $gThinFont -aspect 500  \
		    # -text "Overwrite \"$item(name)\"?"
	    # pack $w.top.x.icon $w.top.x.space $w.top.x.msg -side left -fill y

	    # pack $w.top.x -expand 1

	    # showdialog $w
	    # tkwait window $w

	    # if {$gAnswer == 0} {
		# break
	    # }
	# }

	watch_cursor

	if {$item(kind) == "directory"} {
	    set update [after idle  \
		    "[list updatelist $side]; [list updatelist $other]"]

	    copy_directory $vol($side) $item(name) $vol($other)  \
		    copy_$fstype($side)_to_$fstype($other)  \
		    $fstype($side)_automode
	} else {
	    set update [after idle [list updatelist $other]]

	    if {$gXMode == "auto"} {
		set mode [$fstype($side)_automode $vol($side) item]
	    } else {
		set mode $gXMode
	    }

	    copy_$fstype($side)_to_$fstype($other)  \
		    $vol($side) $item(name) $mode $vol($other)
	}

	after cancel $update
	set needupdate 1

	$box selection clear $ind
    }

    if {$needupdate} {
	updatelist $other; clearlists
    }
}

proc do_info {side} {
    set box $side.mid.lb
    set sel [$box curselection]

    global vol dir

    foreach ind $sel {
	show_info $vol($side) [lindex $dir($side) $ind]
    }
}

proc do_rename {side} {
    global dir
    global gTypeFont

    set box $side.mid.lb
    set sel [$box curselection]
    array set item [lindex $dir($side) [lindex $sel 0]]

    set w [dialog "Rename" "Cancel" "Rename" 1]
    $w.bot.ok config -command [list rename2 $w $side]

    frame $w.top.x

    label $w.top.x.lbl -text "Rename \"$item(name)\" to:"
    label $w.top.x.srcname -text $item(name)
    entry $w.top.x.dstname -width 25 -font $gTypeFont -exportsel 0

    pack $w.top.x.lbl $w.top.x.dstname -side top -pady 0.5m
    pack $w.top.x -expand 1

    $w.top.x.dstname insert end $item(name)
    $w.top.x.dstname selection range 0 end

    focus $w.top.x.dstname
    showdialog $w
}

proc rename2 {w side} {
    global vol

    set srcname [$w.top.x.srcname cget -text]
    set dstname [$w.top.x.dstname get]

    watch_cursor $w
    destroy $w

    if {[string length $dstname] == 0} {
	error "cannot rename to zero-length name"
    }

    if {[string compare $srcname $dstname] != 0} {
	$vol($side) rename $srcname $dstname
	updatelist $side; clearlists
    }
}

proc do_delete {side} {
    set box $side.mid.lb
    set sel [$box curselection]

    global gThinFont gAskDelete gAnswer
    global vol dir

    set sepchar [$vol($side) sepchar]
    set needupdate 0

    foreach ind $sel {
	array set item [lindex $dir($side) $ind]

	$box see $ind

	set recursive [expr {$item(kind) == "directory" && $item(size) > 0}]

	if {$recursive || $gAskDelete} {
	    set w [dialog "Delete" "Cancel" "Delete"]

	    if {$recursive} {
		set p1 "Recursively delete \"$item(name)\""
		set p2 "containing $item(size) item[plural $item(size) "" "s"]"
		set prompt "$p1 $p2?"
	    } else {
		set prompt "Really delete \"$item(name)\"?"
	    }

	    frame $w.top.x
	    label $w.top.x.icon -bitmap caution -anchor n
	    frame $w.top.x.space -width 2m
	    message $w.top.x.msg -font $gThinFont -aspect 500 -text $prompt
	    pack $w.top.x.icon $w.top.x.space $w.top.x.msg -side left -fill y

	    pack $w.top.x -expand 1

	    showdialog $w
	    tkwait window $w

	    if {$gAnswer == 0} {
		break
	    }
	}

	watch_cursor
	set update [after idle "[list updatelist $side]; clearlists"]

	if {$item(kind) == "directory"} {
	    delete_directory $vol($side) $item(name)
	} else {
	    $vol($side) delete $item(name)
	}

	after cancel $update
	set needupdate 1

	$box selection clear $ind
    }

    if {$needupdate} {
	updatelist $side; clearlists
    }
}

proc format_disk {} {
    global gTypeFont gThinFont gLowFormatCmd gDefaultDevice

    set w [dialog "Format Disk" "Cancel" "Format"]
    $w.bot.ok config -command [list format2 $w]

    frame $w.top.x

    set low [frame $w.top.x.low]
    label $low.icon -bitmap floppy

    frame $low.info
    checkbutton $low.info.cb -var gLowFormat  \
	    -text "Low-level Format" -anchor w
    entry $low.info.cmd -width 26 -font $gTypeFont
    pack $low.info.cb $low.info.cmd -side top -fill x -pady 0.5m

    pack $low.icon $low.info -side left -padx 2m

    frame $w.top.x.space1 -height 2m

    label $w.top.x.hfs -text "Initialize as HFS Volume..." -anchor w

    set dev [frame $w.top.x.dev]
    label $dev.lbl -width 6 -text "Device:" -font $gThinFont -anchor w
    entry $dev.name -width 15 -font $gTypeFont
    label $dev.parlbl -text "Partition:" -font $gThinFont
    entry $dev.par -width 2 -font $gTypeFont
    pack $dev.lbl $dev.name $dev.parlbl $dev.par -side left -padx 0.5m

    set vol [frame $w.top.x.vol]
    label $vol.lbl -width 6 -text "Name:" -font $gThinFont -anchor w
    entry $vol.name -width 27 -font $gTypeFont
    pack $vol.lbl $vol.name -side left -padx 0.5m

    frame $w.top.x.space2 -height 2m

    set mount [frame $w.top.x.mount]
    label $mount.lbl -text "Open:" -font $gThinFont
    radiobutton $mount.l -var gMountSide -value ".l"  \
	    -text "On Left" -font $gThinFont
    radiobutton $mount.r -var gMountSide -value ".r"  \
	    -text "On Right" -font $gThinFont
    pack $mount.lbl $mount.l $mount.r -side left

    pack $low $w.top.x.space1 $w.top.x.hfs $dev $vol  \
	    -side top -fill x -pady 0.5m
    pack $w.top.x.space2 $mount -side top -pady 0.5m

    pack $w.top.x -expand 1

    $w.top.x.low.info.cmd insert end $gLowFormatCmd
    $w.top.x.dev.name insert end $gDefaultDevice
    $w.top.x.vol.name insert end "Untitled"

    # focus $w.top.x.dev.name
    showdialog $w
}

proc format2 {w} {
    global gAppCWD gLowFormat gLowFormatCmd gMountSide

    set gLowFormatCmd [$w.top.x.low.info.cmd get]

    set path [$w.top.x.dev.name get]
    set partno [$w.top.x.dev.par get]
    set vname [$w.top.x.vol.name get]

    if {[string length $partno] == 0} {
	set partno 0
    }

    watch_cursor $w
    destroy $w

    cd $gAppCWD

    if {$gLowFormat && [string length $gLowFormatCmd] > 0} {
	exec /bin/sh -c $gLowFormatCmd </dev/null >/dev/null
    }

    if {[string length $path] > 0} {
	hfs format $path $partno $vname
	mountdev $gMountSide $path
    }
}

proc help_about {} {
    global gThinFont gSmallFont gTitleFont

    set w [dialog "About" "OK"]

    set f [frame $w.top.t]

    regsub {\(C\)} [hfs copyright] "\251" copyright

    frame $f.banner
    label $f.banner.icon -bitmap macdaemon
    label $f.banner.title -text "xhfs" -font $gTitleFont
    pack $f.banner.icon $f.banner.title -side left -padx 2m

    frame $f.space -height 2m
    label $f.vers -text [hfs version] -font $gThinFont
    label $f.copy -text $copyright -font $gSmallFont
    label $f.auth -text [hfs author] -font $gSmallFont

    pack $f.banner $f.space $f.vers $f.copy $f.auth -side top
    pack $f -expand 1

    showdialog $w
}

proc help_license {} {
    alert note "Software License" [fixtext [hfs license]] 190
}

proc help_options {} {
    set text "\
	    Show All Files: Some files are normally hidden. To unhide\n\
	    invisible files on HFS volumes, or to unhide UNIX files which\n\
	    begin with a period, select this option.\n\n\
	    \
	    Ask Before Delete: To disable verification before deleting files\n\
	    and empty directories, deselect this option.\n\n\
	    \
	    Auto Mode Select: The transfer mode is normally selected\n\
	    automatically. To use manual selection, deselect this option.\n\n\
	    "

    alert note "Options" [fixtext $text] 150
}

proc help_modes {} {
    set text "\
	    MacBinary II: A popular format for binary file transfer. Both\n\
	    forks of the Macintosh file are preserved. This is the\n\
	    recommended mode for transferring arbitrary Macintosh files.\n\n\
	    \
	    BinHex: An alternative format for ASCII file transfer. Both\n\
	    forks of the Macintosh file are preserved.\n\n\
	    \
	    Text: Performs end-of-line translation. Only the data fork of\n\
	    the Macintosh file is copied.\n\n\
	    \
	    Raw Data: Performs no translation. Only the data fork of the\n\
	    Macintosh file is copied.\n\n\
	    \
	    Automatic: A mode will be chosen automatically for each\n\
	    file based on a set of predefined heuristics.\n\n\
	    "

    alert note "Transfer Modes" [fixtext $text]
}

proc hfs_automode {vol array} {
    upvar $array item

    if {$item(kind) == "directory"} {
	return auto
    } elseif {[regexp {^TEXT|ttro$} $item(type)]} {
	return text
    } elseif {$item(rsize) == 0} {
	return raw
    } else {
	return macb
    }
}

proc ufs_automode {vol array} {
    upvar $array item

    set name $item(name)

    if {$item(kind) == "directory"} {
	return auto
    } elseif {[regexp -nocase {\.bin$} $name]} {
	return macb
    } elseif {[regexp -nocase {\.hqx$} $name]} {
	return binh
    } elseif {[regexp -nocase {\.(txt|c|h|html?|rtf)$} $name]} {
	return text
    } elseif {[regexp -nocase {\.(sit|sea|cpt|tar|gz|Z|gif|jpg)$} $name]} {
	return raw
    } else {
	cd [$vol cwd]
	if {([catch {exec file -L $name} type] == 0 ||  \
		[catch {exec file $name} type] == 0) &&  \
		[regexp {text|commands} $type]} {
	    return text
	}

	return raw
    }
} 

proc watch_cursor {{w "."} {default "left_ptr"}} {
    $w config -cursor watch
    if {[string compare $w "."] != 0} {
	. config -cursor watch
    }
    update idletasks

    $w config -cursor $default
    if {[string compare $w "."] != 0} {
	. config -cursor left_ptr
    }
}

proc updatelist {side} {
    global gShowAllFiles
    global dir vol fstype

    set box $side.mid.lb
    $box delete 0 end

    if {! [info exists vol($side)]} {
	return
    }

    if {$fstype($side) == "hfs"} {
	set chartrans {nulltrans}	;# {hfs charlocal}
    } else {
	set chartrans {nulltrans}
    }

    set list [$vol($side) dir]
    set dir($side) {}

    set sepchar [$vol($side) sepchar]

    foreach ent $list {
	array set item $ent

	set name [eval $chartrans [list $item(name)]]

	if {$item(kind) == "directory"} {
	    set name "$name$sepchar"
	}

	if {$gShowAllFiles || [lsearch $item(flags) "invis"] < 0} {
	    $box insert end $name
	    lappend dir($side) $ent
	}
    }

    set m $side.mb.pop.m
    $m delete 0 end

    set path [$vol($side) path]
    set last 0

    foreach elt $path {
	set partial [abspath [$vol($side) sepchar] [lrange $path 0 $last]]
	incr last

	$m insert 0 command -label $elt -command [list mchdir $side $partial]
    }

    if {$fstype($side) == "hfs"} {
	set what "Folder"
    } else {
	set what "Directory"
    }

    foreach menuitem {
	{separator}
	{command -label "New $what..." -command [list mmkdir $side]}
    } {eval $m insert end $menuitem}

    global cwd
    set cwd($side) [lindex $path [expr [llength $path] - 1]]

    set avail [lindex [$vol($side) size] 1]

    $side.info.x.msg config -text "[size $avail] available"
}

proc clearlists {} {
    .l.mid.lb selection clear 0 end
    .r.mid.lb selection clear 0 end

    .m.1.ops.view config -state disabled -text "View"
    .m.1.ops.copy config -state disabled -text "Copy"

    .m.2.ops.info config -state disabled
    .m.2.ops.rena config -state disabled
    .m.2.ops.dele config -state disabled
}

proc mchdir {side path} {
    global vol

    watch_cursor

    $vol($side) chdir $path

    updatelist $side; clearlists
}

proc open_volume {side} {
    global gDefaultDevice gMountSide gTypeFont gThinFont

    set gMountSide $side

    set w [dialog "Open" "Cancel" "Open" 1]
    $w.bot.ok config -command [list open2 $w]

    frame $w.top.x

    set lbl1 [frame $w.top.x.lbl1]
    label $lbl1.path -text "Path to HFS Device"
    pack $lbl1.path

    set lbl2 [frame $w.top.x.lbl2]
    # label $lbl2.or -text "or"
    # label $lbl2.icon -bitmap sm_floppy
    label $lbl2.dev -text "or UNIX Directory:"
    pack $lbl2.dev -side left -padx 0.5m

    entry $w.top.x.entry -width 25 -font $gTypeFont

    frame $w.top.x.space -height 2m

    set mount [frame $w.top.x.mount]
    label $mount.lbl -text "Open:" -font $gThinFont
    radiobutton $mount.l -var gMountSide -value ".l"  \
	    -text "On Left" -font $gThinFont
    radiobutton $mount.r -var gMountSide -value ".r"  \
	    -text "On Right" -font $gThinFont
    pack $mount.lbl $mount.l $mount.r -side left

    pack $lbl1 $lbl2 $w.top.x.entry $w.top.x.space $mount  \
	    -side top -pady 0.5m

    pack $w.top.x -expand 1

    $w.top.x.entry insert end $gDefaultDevice
    $w.top.x.entry selection range 0 end

    focus $w.top.x.entry
    showdialog $w
}

proc open2 {w} {
    global gMountSide
    global vol

    set path [$w.top.x.entry get]

    watch_cursor $w
    destroy $w

    if {[string length $path] == 0} {
	error "missing path"
    }

    mountdev $gMountSide $path
}

proc close_volume {side} {
    global vol

    watch_cursor

    $vol($side) umount
    unset vol($side)

    pack forget $side.mb.pop $side.info.x.icon $side.info.x.lock
    $side.info.x.msg config -text ""

    $side.sub.open config -text "Open..." -command [list open_volume $side]
    $side.sub.info config -state disabled

    updatelist $side; clearlists
}

proc ctime {secs} {
    return [clock format $secs -format "%c"]
}

proc volume_info {side} {
    global gThinFont
    global vol dev fstype media

    set v $vol($side)

    if {$side == ".l"} {
	set eside "Left"
    } else {
	set eside "Right"
    }

    set w [window "$eside Info" "Info"]

    set locked [$v islocked]
    set icon $media($side)
    set vname [$v vname]

    if {$fstype($side) == "ufs"} {
	set ishfs 0
	set where [file dirname $vname]
	set vname [file tail $vname]
	set kind "UNIX Directory"
    } else {
	set ishfs 1
	set kind "HFS Volume"
	set where $dev($side)
	set crdate [$v crdate]
    }

    wm iconbitmap $w $icon
    wm iconmask $w ${icon}_mask

    frame $w.x
    pack $w.x -expand 1 -fill both -ipadx 4m -ipady 4m

    set f [frame $w.x.f]

    frame $f.name
    frame $f.name.space -width 5
    label $f.name.icon -bitmap $icon
    label $f.name.text -text $vname -font $gThinFont
    pack $f.name.space $f.name.icon $f.name.text -side left -padx 2m

    if {$locked} {
	label $f.name.lock -bitmap padlock
	pack $f.name.lock -side left
    }

    frame $f.space1 -height 4m

    frame $f.kind
    label $f.kind.lbl -width 9 -text "Kind: " -anchor e
    label $f.kind.val -text $kind -font $gThinFont
    pack $f.kind.lbl $f.kind.val -side left

    frame $f.size
    label $f.size.lbl -width 9 -text "Size: " -anchor e
    label $f.size.val -text [size [lindex [$v size] 0]] -font $gThinFont
    pack $f.size.lbl $f.size.val -side left

    frame $f.space2 -height 4m

    frame $f.where
    label $f.where.lbl -width 9 -text "Where: " -anchor e
    label $f.where.val -text $where -font $gThinFont
    pack $f.where.lbl $f.where.val -side left

    pack $f.name $f.space1 $f.kind $f.size $f.space2 $f.where -side top -fill x

    if {$ishfs} {
	frame $f.space3 -height 4m

	frame $f.cr
	label $f.cr.lbl -width 9 -text "Created: " -anchor e
	label $f.cr.val -text [ctime $crdate] -font $gThinFont
	pack $f.cr.lbl $f.cr.val -side left

	pack $f.space3 $f.cr -side top -fill x
    }

    frame $f.md
    label $f.md.lbl -width 9 -text "Modified: " -anchor e
    label $f.md.val -text [ctime [$v mddate]] -font $gThinFont
    pack $f.md.lbl $f.md.val -side left

    pack $f.md -side top -fill x

    pack $f -expand 1

    showwindow $w
}

proc mmkdir {side} {
    global gTypeFont
    global fstype

    if {$fstype($side) == "hfs"} {
	set what "folder"
	set title "New Folder"
    } else {
	set what "directory"
	set title "New Directory"
    }

    set w [dialog $title "Cancel" "Create" 1]
    $w.bot.ok config -command [list mmkdir2 $w $side $what]

    frame $w.top.x

    frame $w.top.x.lbl
    label $w.top.x.lbl.icon -bitmap sm_folder
    label $w.top.x.lbl.text -text "Name for new $what:"
    pack $w.top.x.lbl.icon $w.top.x.lbl.text -side left -padx 0.5m

    entry $w.top.x.entry -width 25 -font $gTypeFont -exportsel 0

    pack $w.top.x.lbl $w.top.x.entry -side top -pady 0.5m
    pack $w.top.x -expand 1

    $w.top.x.entry insert end "untitled $what"
    $w.top.x.entry selection range 0 end

    focus $w.top.x.entry
    showdialog $w
}

proc mmkdir2 {w side what} {
    global vol

    set name [$w.top.x.entry get]

    watch_cursor $w
    destroy $w

    if {[string length $name] == 0} {
	error "cannot create $what with empty name"
    }

    $vol($side) mkdir $name
    $vol($side) chdir $name

    updatelist $side; clearlists
}

proc plural {count single plural} {
    if {$count == 1} {
	return $single
    } else {
	return $plural
    }
}

proc nulltrans {str} {
    return $str
}

proc show_file {side fname} {
    global gTypeFont
    global vol fstype

    watch_cursor

    if {$fstype($side) == "hfs"} {
	set charset macroman
    } else {
	set charset latin1
    }

    # Make sure we can open the file before building the interface
    set fh [$vol($side) open $fname]

    set path [abspath [$vol($side) sepchar]  \
	    [concat [$vol($side) path] [list $fname]] 1]
    set w [window $path $fname]

    frame $w.x
    pack $w.x -expand 1 -fill both -padx 1m -pady 1m

    set f [frame $w.x.f]

    text $f.text -yscroll [list $f.scroll set]  \
	    -height 30 -width 80 -wrap word -font $gTypeFont
    scrollbar $f.scroll -orient vert -command [list $f.text yview]
    pack $f.scroll -side right -fill y
    pack $f.text -fill both -expand 1

    pack $f -fill both -expand 1

    watch_cursor $f.text xterm
    after idle "[list $f.text config -state disabled]; [list showwindow $w]"

    while {1} {
	set buf [$fh read 512]
	if {[string length $buf] == 0} {
	    $fh close
	    break
	}

	regsub -all "\r\n?" $buf "\n" buf

	$f.text insert end [hfs chartrans $charset latin1 $buf]
    }
}

proc commas {number} {
    while {[regexp  \
	    {([^,]+)(([0-9][0-9][0-9])(,[0-9][0-9][0-9])*([^0-9].*|$))}  \
	    $number ignore pre rest]} {
	set number "$pre,$rest"
    }

    return $number
}

proc size {bytes} {
    if {$bytes == -1} {
	return "unknown K"
    }

    set k 1024
    set mb [expr 1024 * $k]

    if {$bytes > $mb} {
	set q $mb
	set u "M"
    } else {
	set q $k
	set u "K"
    }

    set amount [commas [format "%.1f" [expr ${bytes}.0 / $q]]]

    regsub {\.0$} $amount "" amount
    regsub {^0$} $amount "zero " amount

    return "$amount$u"
}

proc show_info {vol list} {
    global gTypeFont gThinFont

    array set info $list

    set isdir [expr [string compare $info(kind) "directory"] == 0]
    set ishfs [info exists info(crdate)]

    if {$ishfs} {
	set chartrans {nulltrans}	;# {hfs charlocal}
    } else {
	set chartrans {nulltrans}
    }

    set name [eval $chartrans [list $info(name)]]
    set w [window "$name Info" $name]

    set icon "document"

    if {$isdir} {
	set icon "folder"

	if {$ishfs} {
	    set info(kind) "folder"
	}
    } else {
	if {$ishfs} {
	    if {[string compare $info(type) "APPL"] == 0} {
		set icon "application"
		set info(kind) "application"
	    } else {
		set info(kind) "document"
	    }
	} else {
	    cd [$vol cwd]
	    if {[file executable $info(name)]} {
		set icon "application"
	    }
	}
    }

    wm iconbitmap $w $icon
    wm iconmask $w ${icon}_mask

    if {$ishfs} {
	set where "[join [$vol path] ":"]:"
    } else {
	set where [$vol cwd]

	cd $where
	if {[catch {exec file $info(name)} type] == 0} {
	    if {[string first "$info(name):" $type] == 0} {
		set type [string range $type  \
			[expr [string length $info(name)] + 1] end]
	    }

	    regsub "^\[ \t]*" $type "" info(kind)
	}
    }

    frame $w.x
    pack $w.x -expand 1 -fill both -ipadx 4m -ipady 4m

    set f [frame $w.x.f]

    frame $f.name
    frame $f.name.space -width 5
    label $f.name.icon -bitmap $icon
    label $f.name.text -text $name -font $gThinFont
    pack $f.name.space $f.name.icon $f.name.text -side left -padx 2m

    if {[lsearch $info(flags) "locked"] >= 0} {
	label $f.name.lock -bitmap padlock
	pack $f.name.lock -side left
    }

    frame $f.space1 -height 4m

    frame $f.kind
    label $f.kind.lbl -width 9 -text "Kind: " -anchor e
    label $f.kind.val -text $info(kind) -font $gThinFont
    pack $f.kind.lbl $f.kind.val -side left

    set label "Size: "
    if {$isdir} {
	set label "Contains: "
	set size $info(size)
	set what [plural $size item items]
    } elseif {$ishfs} {
	set size [list $info(rsize) $info(dsize)]
	set what [list  \
		[plural $info(rsize) byte bytes]  \
		[plural $info(dsize) byte bytes]]
    } else {
	set size $info(size)
	set what [plural $size byte bytes]
    }

    frame $f.size

    if {[llength $size] == 1} {
	label $f.size.lbl -width 9 -text $label -anchor e
	label $f.size.val -text "[commas $size] $what" -font $gThinFont
	pack $f.size.lbl $f.size.val -side left
    } else {
	set rsize [lindex $size 0]
	set rwhat [lindex $what 0]
	set dsize [lindex $size 1]
	set dwhat [lindex $what 1]

	frame $f.size.r
	label $f.size.r.lbl -width 9 -text "Resource: " -anchor e
	label $f.size.r.val -text "[commas $rsize] $rwhat" -font $gThinFont
	pack $f.size.r.lbl $f.size.r.val -side left

	frame $f.size.d
	label $f.size.d.lbl -width 9 -text "Data: " -anchor e
	label $f.size.d.val -text "[commas $dsize] $dwhat" -font $gThinFont
	pack $f.size.d.lbl $f.size.d.val -side left

	pack $f.size.r $f.size.d -side top -fill x
    }

    frame $f.space2 -height 4m

    frame $f.where
    label $f.where.lbl -width 9 -text "Where: " -anchor e
    label $f.where.val -text $where -font $gThinFont
    pack $f.where.lbl $f.where.val -side left

    pack $f.name $f.space1 $f.kind $f.size $f.space2 $f.where -side top -fill x

    if {$ishfs && ! $isdir} {
	frame $f.space3 -height 4m

	frame $f.type
	label $f.type.lbl -width 9 -text "Type: " -anchor e
	label $f.type.val -text $info(type) -font $gTypeFont
	pack $f.type.lbl $f.type.val -side left

	frame $f.crea
	label $f.crea.lbl -width 9 -text "Creator: " -anchor e
	label $f.crea.val -text $info(creator) -font $gTypeFont
	pack $f.crea.lbl $f.crea.val -side left

	pack $f.space3 $f.type $f.crea -side top -fill x
    }

    if {$ishfs} {
	frame $f.space4 -height 4m

	frame $f.cr
	label $f.cr.lbl -width 9 -text "Created: " -anchor e
	label $f.cr.val -text [ctime $info(crdate)] -font $gThinFont
	pack $f.cr.lbl $f.cr.val -side left

	pack $f.space4 $f.cr -side top -fill x
    }

    frame $f.md
    label $f.md.lbl -width 9 -text "Modified: " -anchor e
    label $f.md.val -text [ctime $info(mddate)] -font $gThinFont
    pack $f.md.lbl $f.md.val -side left

    pack $f.md -side top -fill x

    pack $f -expand 1

    showwindow $w
}

proc abspath {sepchar path {asfile 0}} {
    switch $sepchar {
	":" {
	    if {$asfile} {
		return [join $path ":"]
	    } else {
		return "[join $path ":"]:"
	    }
	}

	"/" {
	    if {[string compare [lindex $path 0] "/"] == 0} {
		set path [lreplace $path 0 0 ""]
	    }

	    if {[llength $path] == 1 &&  \
		    [string length [lindex $path 0]] == 0} {
		return "/"
	    } else {
		return [join $path "/"]
	    }
	}
    }
}

proc ufs_handle {dir} {
    set handle "ufsvol[unique]"

    global ufsdir

    cd $dir
    set ufsdir($handle) [pwd]

    proc $handle {verb args} {
	set handle [lindex [info level [info level]] 0]
	global gAppCWD gDfCmd
	global ufsdir

	set cwd $ufsdir($handle)

	switch -glob $verb {
	    vname {
		return $cwd
	    }

	    umount {
		cd $gAppCWD

		unset ufsdir($handle)
		rename $handle ""
	    }

	    path {
		set path [split $cwd "/"]

		if {[string compare [lindex $path 0] ""] == 0} {
		    set path [lreplace $path 0 0 "/"]
		}

		if {[llength $path] == 2 &&  \
			[string length [lindex $path 1]] == 0} {
		    set path [lreplace $path 1 1]
		}

		return $path
	    }

	    dir {
		cd $cwd

		set list {}
		set files [lsort [glob .* *]]

		foreach name $files {
		    if {[string compare $name "."] == 0 ||  \
			    [string compare $name ".."] == 0} {
			continue
		    }

		    if {[catch {file stat $name stat}]} {
			continue
		    }

		    set kind [file type $name]
		    set mddate $stat(mtime)

		    if {[file isdirectory $name]} {
			set kind "directory"
			set size "?"
			catch {
			    set size [expr [llength  \
				    [glob $name/.* $name/*]] - 2]
			}
		    } elseif {$kind == "file"} {
			set size $stat(size)
		    } else {
			continue
		    }

		    set flags {}

		    if {! [file writable $name]} {
			lappend flags "locked"
		    }

		    if {[regexp {^\.} $name]} {
			lappend flags "invis"
		    }

		    lappend list [list  \
			    name $name  \
			    kind $kind  \
			    size $size  \
			    flags $flags  \
			    mddate $mddate]
		}

		return $list
	    }

	    chdir {
		set path [lindex $args 0]

		if {! [regexp {^/} $path]} {
		    cd $cwd
		}

		cd $path
		set ufsdir($handle) [pwd]
	    }

	    cwd {
		return $cwd
	    }

	    sepchar {
		return "/"
	    }

	    mkdir {
		set path [lindex $args 0]

		cd $cwd
		exec mkdir $path
	    }

	    rmdir {
		set path [lindex $args 0]

		cd $cwd
		exec rmdir $path
	    }

	    open {
		set path [lindex $args 0]

		cd $cwd
		set fh [open $path]

		proc $fh {verb args} {
		    set fh [lindex [info level [info level]] 0]

		    switch -glob $verb {
			read {
			    set len [lindex $args 0]

			    return [read $fh $len]
			}

			close {
			    close $fh
			    rename $fh ""
			}

			* {
			    error "unknown call to $fh $verb $args"
			}
		    }
		}

		return $fh
	    }

	    copy {
		set path [lindex $args 0]
		set dest [lindex $args 1]

		cd $cwd
		exec cp -f $path $dest
	    }

	    rename {
		set path [lindex $args 0]
		set dest [lindex $args 1]

		cd $cwd
		exec mv -f $path $dest
	    }

	    delete {
		set path [lindex $args 0]

		cd $cwd
		exec rm -f $path
	    }

	    size {
		if {[catch {eval exec [join $gDfCmd " "] [list $cwd]} info]} {
		    return [list -1 -1]
		}

		set s "\[ \t]+"
		set d "\[0-9]+"

		if {[catch {
		    regexp "(.*)\n(\[^\n]*)\$" $info ignore head data
		    regexp "${s}($d)$s$d${s}($d)" $data ignore size avail
		}]} {
		    return [list -1 -1]
		}

		set block 512
		if {[regexp -nocase {kbyte|1024} $head]} {
		    set block 1024
		}

		return [list [expr $size * $block] [expr $avail * $block]]
	    }

	    mddate {
		return [file mtime $cwd]
	    }

	    islocked {
		return 0
	    }

	    * {
		error "unknown call to $handle $verb $args"
	    }
	}
    }

    return $handle
}

proc ufs {verb args} {
    switch $verb {
	mount {
	    set dir [lindex $args 0]

	    return [ufs_handle $dir]
	}

	* {
	    error "bad arg 1 to ufs"
	}
    }
}

proc mountdev {side device} {
    global gAppCWD gXMode
    global vol dev fstype media

    if {[info exists vol($side)]} {
	$vol($side) umount
    }

    cd $gAppCWD

    if {! [file exists $device]} {
	error "can't open $device (no such file or directory)"
    }

    if {[file isdirectory $device]} {
	set type ufs
    } else {
	set type hfs
    }

    set v [$type mount $device]
    set fstype($side) $type
    set locked [$v islocked]

    if {$type == "ufs"} {
	set icon "folder"
    } else {
	set size [lindex [$v size] 0]

	if {$size <= [expr 1440 * 1024]} {
	    set icon "floppy"
	} elseif {$locked &&  \
		$size >= [expr 100 * 1024 * 1024] &&  \
		$size <= [expr 800 * 1024 * 1024]} {
	    set icon "cdrom"
	} else {
	    set icon "harddisk"
	}
    }

    $side.info.x.icon config -bitmap sm_$icon
    pack $side.info.x.icon -before $side.info.x.msg -side left -padx 0.5m

    if {$locked} {
	pack $side.info.x.lock -side left -padx 0.5m
    } else {
	pack forget $side.info.x.lock
    }

    pack $side.mb.pop

    $side.sub.open config -text "Close" -command [list close_volume $side]
    $side.sub.info config -state normal

    set vol($side) $v
    set dev($side) $device
    set media($side) $icon

    updatelist $side; clearlists

    if {$fstype(.l) == $fstype(.r)} {
	set state disabled
	set gXMode auto
    } else {
	set state normal
    }

    foreach mode {auto macb binh text raw} {
	.m.3.mode.$mode config -state $state
    }
}

proc flushtask {} {
    global gFlushInterval

    after $gFlushInterval flushtask

    watch_cursor
    hfs flushall
}

###############################################################################

# Apparently some versions of Tk don't grok this
if {$argc > 0 && [string compare [lindex $argv 0] "--"] == 0} {
    incr argc -1
    set argv [lreplace $argv 0 0]
}

if {[string compare [lindex $argv 0] "--license"] == 0} {
    puts -nonewline stdout "\n[hfs license]"
    exit
}

if {[string compare [lindex $argv 0] "--version"] == 0} {
    puts stdout "[hfs version] - [hfs copyright]"
    puts stdout "`$argv0 --license' for licensing information."
    exit
}

###############################################################################

# Build the user interface

proc makelist {w click other} {
    global gSmallFont

    frame $w

    frame $w.mb -height 30
    menubutton $w.mb.pop -textvariable cwd($w)  \
	    -indicatoron 1 -menu $w.mb.pop.m  \
	    -relief raised -bd 2 -padx 4p -pady 4p  \
	    -highlightthickness 2 -anchor c
    menu $w.mb.pop.m -tearoff 0

    frame $w.info -height 16
    pack propagate $w.info 0

    frame $w.info.x
    pack $w.info.x -expand 1

    label $w.info.x.icon
    label $w.info.x.msg -font $gSmallFont -text ""
    label $w.info.x.lock -bitmap padlock

    pack $w.info.x.msg -side left -padx 0.5m

    frame $w.mid -bd 0

    listbox $w.mid.lb -xscroll "$w.bot.sb set" -yscroll "$w.mid.sb set"  \
	    -exportselection 0 -height 16 -width 25 -selectmode extended
    scrollbar $w.mid.sb -orient vert -command [list $w.mid.lb yview]

    bind $w.mid.lb <Button-1> [list $other selection clear 0 end]
    bind $w.mid.lb <KeyPress> [list $other selection clear 0 end]
    bind $w.mid.lb <ButtonRelease-1> [list wclick $w $click]
    bind $w.mid.lb <KeyRelease> [list wclick $w $click]
    bind $w.mid.lb <Double-ButtonRelease-1> ".m.1.ops.view invoke"
    bind $w.mid.lb <Key-Return> ".m.1.ops.view invoke"

    pack $w.mid.sb -side right -fill y
    pack $w.mid.lb -side right -fill both -expand 1

    frame $w.bot

    scrollbar $w.bot.sb -orient horiz -command [list $w.mid.lb xview]
    frame $w.bot.c -height 24 -width 24

    # label $w.bot.c.icon
    # pack $w.bot.c.icon -expand 1
    # pack propagate $w.bot.c 0

    pack $w.bot.c -side right
    pack $w.bot.sb -side bottom -fill x

    frame $w.sub -relief sunken -bd 1

    frame $w.sub.space1 -width 1m
    button $w.sub.open -width 8 -text "Open..."  \
	    -command [list open_volume $w]
    button $w.sub.info -width 8 -text "Volume Info" -state disabled  \
	    -command [list volume_info $w]

    frame $w.sub.space2 -width 1m
    pack $w.sub.space1 -side left
    pack $w.sub.open $w.sub.info  \
	    -side left -pady 1m -padx 0.5m -fill x -expand 1
    pack $w.sub.space2 -side left

    frame $w.space -height 2m

    pack $w.space -side bottom
    pack $w.mb -side top
    pack $w.sub -side bottom -fill x -pady 1m -ipadx 2m
    pack $w.info $w.bot -side bottom -fill x
    pack $w.mid -side top -fill both -expand 1
}

proc wclick {side copytext} {
    set box $side.mid.lb
    set sel [$box curselection]

    global gXMode gAutoModeSelect
    global vol dir fstype

    if {$side == ".l"} {
	set other ".r"
    } else {
	set other ".l"
    }

    set cstate normal
    if {! [info exists vol($other)]} {
	set cstate disabled
    }

    if {[llength $sel] == 0} {
	.m.1.ops.view config -state disabled -text "View"
	.m.1.ops.copy config -state disabled -text "Copy"

	.m.2.ops.info config -state disabled
	.m.2.ops.rena config -state disabled
	.m.2.ops.dele config -state disabled
    } elseif {[llength $sel] == 1} {
	array set item [lindex $dir($side) [lindex $sel 0]]

	switch -glob $item(kind) {
	    directory {
		set viewtext "Open"
		set vstate normal
	    }

	    file {
		set viewtext "View"
		set mode [$fstype($side)_automode $vol($side) item]

		if {$mode == "text" || $mode == "binh"} {
		    set vstate normal
		} else {
		    set vstate disabled
		}
	    }
	}

	.m.1.ops.view config -state $vstate -text $viewtext  \
		-command [list do_open $side]
	.m.1.ops.copy config -state $cstate -text $copytext  \
		-command [list do_copy $side $other]

	.m.2.ops.info config -state normal -command [list do_info $side]
	.m.2.ops.rena config -state normal -command [list do_rename $side]
	.m.2.ops.dele config -state normal -command [list do_delete $side]

	if {$gAutoModeSelect &&  \
		[.m.3.mode.auto cget -state] != "disabled"} {
	    if {[info exists mode]} {
		set gXMode $mode
	    } else {
		set gXMode [$fstype($side)_automode $vol($side) item]
	    }
	}
    } else {
	.m.1.ops.view config -state disabled -text "View"
	.m.1.ops.copy config -state $cstate -text $copytext  \
		-command [list do_copy $side $other]

	.m.2.ops.info config -state normal -command [list do_info $side]
	.m.2.ops.rena config -state disabled
	.m.2.ops.dele config -state normal -command [list do_delete $side]

	if {$gAutoModeSelect &&  \
		[.m.3.mode.auto cget -state] != "disabled"} {
	    foreach ind $sel {
		array set item [lindex $dir($side) $ind]
		set auto [$fstype($side)_automode $vol($side) item]

		if {[info exists mode]} {
		    if {$mode != $auto} {
			set mode auto
			break
		    }
		} else {
		    set mode $auto
		}
	    }

	    set gXMode $mode
	}
    }
}


# Middle controls

frame .m

frame .m.1
frame .m.1.ops -relief sunken -bd 1
frame .m.1.ops.space1 -height 0.5m
button .m.1.ops.view -state disabled -text "View"
button .m.1.ops.copy -state disabled -text "Copy"
frame .m.1.ops.space2 -height 0.5m

pack  \
	.m.1.ops.space1  \
	.m.1.ops.view .m.1.ops.copy  \
	.m.1.ops.space2  \
	-side top -fill x -padx 1m -pady 0.5m
pack .m.1.ops -side top -fill x

frame .m.2
frame .m.2.ops -relief sunken -bd 1
frame .m.2.ops.space1 -height 0.5m
button .m.2.ops.info -state disabled -text "Get Info"
button .m.2.ops.rena -state disabled -text "Rename..."
button .m.2.ops.dele -state disabled -text "Delete"
frame .m.2.ops.space2 -height 0.5m

pack  \
	.m.2.ops.space1  \
	.m.2.ops.info .m.2.ops.rena .m.2.ops.dele  \
	.m.2.ops.space2  \
	-side top -fill x -padx 1m -pady 0.5m
pack .m.2.ops -side top -fill x

frame .m.3
label .m.3.l -text "Mode"
frame .m.3.mode -relief groove -bd 2

frame .m.3.mode.space1 -height 1m
radiobutton .m.3.mode.macb -font $gThinFont -text "MacBinary II"  \
	-var gXMode -value macb -anchor w
radiobutton .m.3.mode.binh -font $gThinFont -text "BinHex"  \
	-var gXMode -value binh -anchor w
radiobutton .m.3.mode.text -font $gThinFont -text "Text"  \
	-var gXMode -value text -anchor w
radiobutton .m.3.mode.raw -font $gThinFont -text "Raw Data"  \
	-var gXMode -value raw -anchor w
radiobutton .m.3.mode.auto -font $gThinFont -text "Automatic"  \
	-var gXMode -value auto -anchor w
frame .m.3.mode.space2 -height 1m

set gXMode auto

pack  \
	.m.3.mode.space1  \
	.m.3.mode.macb  \
	.m.3.mode.binh  \
	.m.3.mode.text  \
	.m.3.mode.raw  \
	.m.3.mode.auto  \
	.m.3.mode.space2  \
	-side top -fill x -padx 1m
pack .m.3.l .m.3.mode -side top -fill x

pack .m.1 .m.2 .m.3 -side top -fill x -padx 2m -pady 2m


# Menu bar

frame .mb -relief raised -bd 2
frame .mbpad -height 3m
menubutton .mb.file -text "File" -menu .mb.file.m
menubutton .mb.opts -text "Options" -menu .mb.opts.m
menubutton .mb.help -bitmap help -menu .mb.help.m

pack .mb.file .mb.opts -side left
pack .mb.help -side right -fill y -ipadx 2m

menu .mb.file.m -tearoff 0
foreach menuitem {
    {command -label "Open..." -command {open_volume $gMountSide}}
    {separator}
    {command -label "Format Disk..." -command "format_disk"}
    {command -label "Eject Disk" -command "hfs flushall; exec eject"}
    {separator}
    {command -label "Quit" -command "destroy ."}
} {eval .mb.file.m add $menuitem}

menu .mb.opts.m -tearoff 0
foreach menuitem {
    {checkbutton -label "Show All Files" -variable gShowAllFiles  \
	    -command "watch_cursor; updatelist .l; updatelist .r; clearlists"}
    {separator}
    {checkbutton -label "Ask Before Delete" -variable gAskDelete}
    {checkbutton -label "Auto Mode Select" -variable gAutoModeSelect}
} {eval .mb.opts.m add $menuitem}

set gAutoModeSelect 1
set gAskDelete 1

menu .mb.help.m -tearoff 0
foreach menuitem {
    {command -label "About" -command "help_about"}
    {command -label "Software License" -command "help_license"}
    {separator}
    {command -label "Options" -command "help_options"}
    {command -label "Transfer Modes" -command "help_modes"}
} {eval .mb.help.m add $menuitem}


# Put it together

makelist .l ">> Copy >>" .r.mid.lb
makelist .r "<< Copy <<" .l.mid.lb

rename makelist ""

pack .mb .mbpad -side top -fill x
pack .l -side left -fill both -expand 1 -padx 3m
pack .r -side right -fill both -expand 1 -padx 3m
pack .m -side left

wm title . "Macintosh HFS Volume Browser"

wm iconbitmap . macdaemon
wm iconmask . macdaemon_mask
wm iconname . "HFS Browser"

. config -cursor left_ptr

###############################################################################

tk appname xhfs

set gAppCWD [pwd]

set fstype(.l) none
set fstype(.r) none

if {$argc > 2} {
    puts stderr "Usage: $argv0 \[left-vol \[right-vol]]"
    exit 1
}

if {$argc > 0} {
    mountdev .l [lindex $argv 0]

    if {$argc > 1} {
	mountdev .r [lindex $argv 1]
    }
}

if {$argc < 2} {
    mountdev .r .
}

after $gFlushInterval flushtask