#!/usr/local/bin/wish -f
# -*- tcl -*-
set rcsid { $Id: tkhfs,v 1.26 1994/11/10 01:17:04 jmz Exp jmz $ }

#  Copyright (c) 1994 by Jean-Marc Zucconi (jmz@cabri.obs-besancon.fr)
#  Everyone is granted permission to copy, modify and redistribute.
#  This notice must be preserved on all copies or derivates.

# hfs program
set hfs ../hfs

#the font for the listboxes. Must be a fixed font
set font fixed;


set hfs_device "";           # the environment variable HFS_DEVICE
set hfs_partition 0;         # the current hfs partition
set partitions_number 0;     # the number of available mac partitions
set partitions "";           # the list of volume names
set partitions_indexes "";   # the list of partitions indexes
set names_list "";           # the list of file names
set sizes_list "";           # the list of sizes for data and resource
set type_creator_list "";    # the list of type/creator 
set dates_list "";           # the list of files dates
set flags_list "";           # the flags for files (volume/directory/plain file)
set hidden_files 0;          # set to 1 if hidden files must be displayed
set dr_sizes 0;              # set to 1 if sizes must be displayed
set type_creator 0;          # set to 1 if type and creator must be displayed
set file_date 0;             # set to 1 if date must be displayed
set depth 0;                 # depth in directory tree
set dirnames(-1) "";         # array of names of directory tree
set dirpos(-1) 0;            # array which record the position in listboxes.
set button_text "";          # the current directory
set actions(-1) "";          # how to display files according to their type
set wwidth 0;                # estimation of window width in chars

# font translation
set ___ "\xa4"
set mac_font "\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\\\]^_`abcdefghijklmnopqrstuvwxyz\{|\}~\x7f\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8a\x8b\x8c\x8d\x8e\x8f\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9a\x9b\x9c\x9d\x9e\x9f\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\xba\xbb\xbc\xbd\xbe\xbf\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\xd0\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xda\xdb\xdc\xdd\xde\xdf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc\xfd\xfe\xff";
set iso_font "\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\\\]^_`abcdefghijklmnopqrstuvwxyz\{|\}~$___\xc4\xc5\xc7\xc9\xd1\xd6\xdc\xe1\xe0\xe2\xe4\xe3\xe5\xe7\xe9\xe8\xea\xeb\xed\xec\xee\xef\xf1\xf3\xf2\xf4\xf6\xf5\xfa\xf9\xfb\xfc$___\xb0\xa2\xa3\xa7\xb7\xb6\xdf\xae\xa9$___\xb4\xa8$___\xc6\xd8$___\xb1$___$___\xa5\xb5\xf0$___$___$___$___\xaa\xba$___\xe6\xf8\xbf\xa1\xac$___\x66$___$___\xab\xbb\x2e\x5f\xc0\xc3\xd5$___$___\xad\xad\x22\x22\x60\x27\xf7$___\xff$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___$___";
for {set i 0} {$i < 255} {incr i} {
    set char_translate([string index $mac_font $i]) [string index $iso_font $i];
}

regexp {([1-9]+\.[0-9]+)} $rcsid version ;

proc iso_translate {str} {
    global char_translate;

    set new "";
    set l [string len $str];
    for {set i 0} {$i < $l} {incr i} {
	set c [string index $str $i];
	append new $char_translate($c);
    }
    return $new;
}

# error box
proc errbox {msg} {
    toplevel .error; 
    message .error.label -text $msg -aspect 2000;
    button .error.button -text "OK" -command "set i 1";
    pack .error.label -side top -padx 1m -pady 2m -fill x
    pack .error.button -expand yes -pady 1m
    tkwait variable i;
    destroy .error;
}
# set a new device name
proc get_device {w msg} {
    global env hfs_device;

    message $w.label -text $msg -aspect 200;
    entry $w.entry -relief sunken -textvariable hfs_device -bd 2;
    set l [string length $hfs_device];
    set l0 [lindex [$w.entry configure -width] 4];
    if {$l > $l0} {
	$w.entry configure -width $l;
    }
    button $w.button -text "OK" -command "set i 1";
    pack $w.label $w.entry -side top -padx 1m -pady 2m -fill x
    pack $w.button -expand yes -pady 1m
    bind $w.entry <Return> "set i 1";
    set f [focus];
    focus $w.entry;
    tkwait variable i;
    if { $w != "" } {
	destroy $w
    } else {
	destroy $w.label
	destroy $w.entry
	destroy $w.button
    }
    set env(HFS_DEVICE) $hfs_device
    focus $f;
}


if {[info exists env(HFS_DEVICE)]} {
    set hfs_device $env(HFS_DEVICE);
} else {
    get_device "" "Device not set in environment.\n\nSelect a device:";
}

# read_configuration file;
if {[info exists env(TKHFS)]} {
    set f $env(TKHFS);
} else {
    set f "~/.tkhfs";
}
if {[file readable $f]} {
    set fd [open $f r];
    set re {^[ 	]*(\#|$)};
    while {[gets $fd line] >= 0} {
	if {[regexp $re $line] == 0} {
	    # format: TYPE [-d|-r] action
	    set t [string range $line 0 3];
	    set line [string trimleft [string range $line 4 end]];
#	    set i [string range $line 0 1];
#	    if {$i != "-d" && $i != "-r"} {
#		set i "-d";
#	    } else {
#		set line [string trimleft [string range $line 2 end]];
#	    }
#	    set actions($t) "$i $line"
	    set actions($t) $line
	}
    }
    close $fd;
}
# get the partition list for the device. Set the variable partition_number to 0 
# if there is no partition (floppy) or to the number of partitions. Set two 
# lists: a list of volume names and a list of partition indexes (for use with
# the -d option in hfs).
proc partition_list {} {
    global hfs hfs_device;
    global partitions partitions_indexes partitions_number;
    
    set partitions "";
    set partitions_indexes "";
    set partitions_number 0;
    set err [catch {set result [exec $hfs part -d $hfs_device]}];
    if {$err != 0} { #assume hfs volume w/o partition table
	return;
    }
    # decode output:
    #No.  Size    Name
    #---------------------------------------------
    #N1   sss1   str1
    #N2   sss2   str2
    #...
    #Nn   sssn   strn
    set l [split $result "\n"];
    for {set i 2} {$i < [llength $l] } {incr i} {
	set str [string trim [lindex $l $i]];
	# parse the string
	set strs [split $str];
	lappend partitions_indexes [string trim [lindex $strs 0]];
	set m [string first M $str];
	incr m;
	lappend partitions [string trim [string range $str $m end]];
	incr partitions_number;
    }
}


frame .w

# set up menu
set mframe [frame .w.menu -relief raised -borderwidth 1]
pack $mframe -fill x -side top

menubutton $mframe.file -text "File" -menu $mframe.file.menu

set m [menu $mframe.file.menu]
$m add command -label "Change device..." -command \
    {set old_device $hfs_device;
	toplevel .hfs_device; 
	get_device .hfs_device "Device: "; 
	if {$hfs_device != $old_device} {
	    partition_list;
	    do_dir "t";
	    fillboxes;
	}
    }
$m add separator
$m add command -label "Quit" -command "exit 0";

menubutton $mframe.display -text "Display" -menu $mframe.display.menu;
set m [menu $mframe.display.menu]
$m add checkbutton -label "hidden files" -variable hidden_files -command \
    display_hidden
$m add checkbutton -label "type/creator" -variable type_creator -command \
    display_type_creator
$m add checkbutton -label "data/resource size" -variable dr_sizes -command \
    display_sizes
$m add checkbutton -label "date" -variable file_date -command \
    display_date

menubutton $mframe.help -text "Help" -menu $mframe.help.menu
set m [menu $mframe.help.menu]
$m add command -label "About tkhfs" -command about_tkhfs;
$m add separator
$m add command -label "Device" -command help_device;
$m add command -label "Configuration" -command help_config;

pack $mframe.file $mframe.display -side left -in $mframe
pack $mframe.help -side right -in $mframe

# this procedure get the directory listing and build the following lists:
# names_list, sizes_list, type_creator_list, dates_list, flags_list
proc do_dir {{d ""}} {
    global names_list sizes_list type_creator_list dates_list flags_list;
    global hidden_files partitions_number partitions;
    global hfs;

    if {$d == "t"} {
	# the 'root' dir
	if {$partitions_number != 0} {
	    set flags_list "";
	    set names_list "";
	    set sizes_list "";
	    set type_creator_list "";
	    set dates_list "";
	    for {set i 0} {$i < $partitions_number} {incr i} {
		lappend names_list [iso_translate [lindex $partitions $i]];
		lappend flags_list "V";
	    }
	    return "";
	} else {
	    catch {exec $hfs cd : }
	}
    }
    if {$hidden_files == 0} {
	set err [catch {set dir [exec $hfs ls -l]} msg];
    } else {
	set err [catch {set dir [exec $hfs ls -la]} msg];
    }
    if {$err == 1} {
	errbox $msg;
	return 1;
    }
    set flags_list "";
    set names_list "";
    set lst [split $dir "\n"];
    set sizes_list "";
    set type_creator_list "";
    set dates_list "";
    foreach str $lst  {
	lappend names_list [string range $str 49 end]; 
	lappend dates_list [string range $str 34 45];
	set rsize [string range $str 25 31];
	if {$rsize == "       "} {
	    set flag "D";
	    lappend sizes_list " ";
	} else {
	    set dsize [string range $str 15 21];
	    set flag " ";
	    lappend sizes_list "$dsize / $rsize";
	}
	lappend flags_list $flag
	if {$flag == " "} {
	    set type [string range $str 7 10];
	    if {$type == "    "} {
		set type "????";
	    }
	    set creator [string range $str 0 3];
	    if {$creator == "    "} {
		set creator "????";
	    }
	    lappend type_creator_list "$type / $creator";
	} else {
	    lappend type_creator_list " ";
	}
    }
    return "";
}

#scroll listboxes
proc mscroll {i} {
    global type_creator dr_sizes file_date;

    .w.listboxes.type yview $i;
    .w.listboxes.name yview $i;
    if {$type_creator == 1} {
	.w.listboxes.type_creator yview $i;
    }
    if {$dr_sizes == 1} {
	.w.listboxes.sizes yview $i;
    }
    if {$file_date == 1} {
	.w.listboxes.dates yview $i;
    }
}

frame .w.listboxes
#set up listboxes
scrollbar .w.listboxes.scroll -command mscroll;
pack .w.listboxes.scroll -side right -fill y
listbox .w.listboxes.type -yscroll ".w.listboxes.scroll set" -relief groove \
    -geometry 2x15
set i [option get .w.listboxes.type font Font];
if {$i != ""} {
    set font $i;
} else {
    .w.listboxes.type configure -font $font
}
pack .w.listboxes.type -side left -expand yes -fill both -in .w.listboxes
bind .w.listboxes.type  <ButtonPress-1> " ";
listbox .w.listboxes.name -yscroll ".w.listboxes.scroll set" -relief groove \
    -geometry 32x15 -font $font
pack .w.listboxes.name -side left -expand yes -fill both -in .w.listboxes
tk_listboxSingleSelect .w.listboxes.name;
bind .w.listboxes.name <Double-Button-1> double_click;
if {$type_creator == 1} {
    listbox .w.listboxes.type_creator -yscroll ".w.listboxes.scroll set" -relief groove \
	-geometry 12x15 -font $font
    bind .w.listboxes.type_creator  <ButtonPress-1> " ";
}
if {$dr_sizes == 1} {
    listbox .w.listboxes.sizes -yscroll ".w.listboxes.scroll set" -relief groove \
	-geometry 18x15 -font $font
    bind .w.listboxes.sizes  <ButtonPress-1> " ";
}
if {$file_date == 1} {
    listbox .w.listboxes.dates -yscroll ".w.listboxes.scroll set" -relief groove \
	-geometry 13x15 -font $font
    bind .w.listboxes.dates  <ButtonPress-1> " ";
}


button .w.up -relief groove -textvariable button_text;
bind .w.up <ButtonPress-1>   {select_updir 1 %X %Y};
bind .w.up <ButtonRelease-1> {select_updir 3 %X %Y};
bind .w.up <B1-Motion>       {select_updir 2 %X %Y};
pack .w.up .w.listboxes -side top -fill x

proc fillboxes {} {
    global names_list flags_list dates_list type_creator_list sizes_list;
    global type_creator dr_sizes file_date wwidth;

    .w.listboxes.type delete 0 end;
    .w.listboxes.name delete 0 end;
    catch {.w.listboxes.type_creator delete 0 end;}
    catch {.w.listboxes.sizes delete 0 end;}
    catch {.w.listboxes.dates delete 0 end;}
    foreach i $flags_list {
	.w.listboxes.type insert end $i;
    }
    pack .w.listboxes.type -side left -expand yes -fill both -in .w.listboxes
    bind .w.listboxes.type  <ButtonPress-1> " ";
    foreach i $names_list {
	.w.listboxes.name insert end [iso_translate $i];
    }
    pack .w.listboxes.name -side left -expand yes -fill both -in .w.listboxes
    tk_listboxSingleSelect .w.listboxes.name;
    set wwidth 34.5;

    if {$type_creator == 1} {
	set wwidth [expr $wwidth+12.3];
	foreach i $type_creator_list {
	    .w.listboxes.type_creator insert end $i;
	}
	pack .w.listboxes.type_creator -side left -expand yes -fill both \
	    -in .w.listboxes
	tk_listboxSingleSelect .w.listboxes.type_creator;
    }
    if {$dr_sizes == 1} {
	set wwidth [expr $wwidth+18.3];
	foreach i $sizes_list {
	    .w.listboxes.sizes insert end $i;
	}
	pack .w.listboxes.sizes -side left -expand yes -fill both \
	    -in .w.listboxes
	tk_listboxSingleSelect .w.listboxes.sizes;
    }
    if {$file_date == 1} {
	set wwidth [expr $wwidth+13.3];
	foreach i $dates_list {
	    .w.listboxes.dates insert end $i;
	}
	pack .w.listboxes.dates -side left -expand yes -fill both \
	    -in .w.listboxes
	tk_listboxSingleSelect .w.listboxes.dates;
    }
}

set button_text "<desktop>";
set depth 0;
set dirnames(0) $button_text;
set dirpos(0) 0;
partition_list;
do_dir "t";
fillboxes;

pack .w
bind .w <Any-KeyPress> {scrollto %K}
focus .w

set alph ""
for {set i 33} {$i < 255} {incr i} {
    append alph [format "%c" $i];
}
proc scrollto {c} {
    global alph names_list;
    if {[string length $c] != 1} {
	set t [.w.listboxes.name nearest 0];
	switch $c {
	    "Up" {incr t -1; mscroll $t}
	    "Down" {incr t; mscroll $t}
	    "Prior" {incr t -15; mscroll $t}
	    "Next" {incr t 15; mscroll $t}
	}
	return;
    }
    set c [string tolower $c];
    set C [string toupper $c];
    set i [string first $c $alph];
    while {$i >= 0} {
	set p [lsearch -regexp $names_list ^$c|^$C];
	if {$p != -1} {
	    break;
	}
	incr i -1;
    }
    mscroll $p;
}
proc display_hidden {} {
    global button_text partitions_number depth;

    if {$depth == 0 && $partitions_number != 0} {
	return;
    }
    .w configure -cursor watch;
    update idletasks;
    do_dir;
    fillboxes;
    .w configure -cursor top_left_arrow;
}
proc display_sizes {} {
    global dr_sizes font;

    if {$dr_sizes == 1} {
	listbox .w.listboxes.sizes -yscroll ".w.listboxes.scroll set" -relief groove \
	    -geometry 18x15 -font $font
    } else {
	destroy .w.listboxes.sizes;
    }
    fillboxes;
}
proc display_type_creator {} {
    global type_creator font;

    if {$type_creator == 1} {
	listbox .w.listboxes.type_creator -yscroll ".w.listboxes.scroll set" -relief groove \
	    -geometry 12x15 -font $font
	bind .w.listboxes.type_creator  <ButtonPress-1> " ";
    } else {
	destroy .w.listboxes.type_creator;
    }
    fillboxes;
}
proc display_date {} {
    global file_date font;

    if {$file_date == 1} {
	listbox .w.listboxes.dates -yscroll ".w.listboxes.scroll set" -relief groove \
	    -geometry 13x15 -font $font
	bind .w.listboxes.dates  <ButtonPress-1> " ";
    } else {
	destroy .w.listboxes.dates;
    }
    fillboxes;
}
proc updir {d} {
    global hfs button_text depth dirnames dirpos partitions_number dirpos;

    if {$button_text == ""} {
	return;
    }
    .w configure -cursor watch;
    update idletasks;
    incr depth [expr (-1-[string length $d])/3];
    if {$depth == 0 && $partitions_number != 0} {
	do_dir "t";
    } else {
	catch {exec $hfs cd $d}
	do_dir;
    }
    fillboxes;
    set button_text $dirnames($depth);
    ####################################    mscroll $dirpos($depth);
    .w configure -cursor top_left_arrow;
}
proc select_updir {k x y} {
    global depth dirnames button_text wwidth font;

    if {$depth == 0} {
	return;
    }
    if {$k == 1} {
	menu .menu -borderwidth 1m;
	set d "..";
	set i $depth;
	#  bad computation below!! What we need is a proc to compute 
	#  the width in pixels of a string. Workaround: use a fixed font
	set lab $dirnames($i);
	set n [expr ($wwidth - [string length $lab])/2];
	set in [expr int($n)];
	set t [string range "                                                          "  0 $in];
	set lab "$t$lab$t";
	if {$n != $in} {
	    append lab " ";
	}
	.menu add command -label $lab -command " " -font $font;
	.menu add separator
	incr i -1;
	while {$i >= 0} {
	    .menu add command -label $dirnames($i) -command "updir $d";
	    append d ":..";
	    incr i -1;
	}
	.menu post [winfo rootx .w.up] [winfo rooty .w.up];
	return;
    }
    if {$k == 3} {
	.menu invoke active;
	.menu unpost;
	destroy .menu
	return;
    }
    if {[winfo ismapped .menu]} {
	set w1 [winfo rootx .menu];
	set w2 [expr $w1 + [winfo width .menu]];
	if {$x >= $w1 &&  $x <= $w2} {
	    .menu activate @[expr "$y - [winfo rooty .menu]"];
	} else {
	    .menu activate none;
	}
    }
}
proc double_click {} {
    global names_list flags_list hfs_partition partitions partitions_indexes;
    global hfs env button_text depth dirnames in_double_click dirpos;

    set in_double_click 1;
    .w configure -cursor watch;
    update idletasks;
    set sel [.w.listboxes.name curselection];
    if {$sel == ""} {
	return;
    }
    set i [lindex $sel 0];
    set flag [lindex $flags_list $i];
    set b [lindex $names_list $i];
    if {$flag == "V"} {
	#	puts "volume change";
	set hfs_partition [lindex $partitions_indexes $i];
	set env(HFS_PARTITION) $hfs_partition;
	catch {exec $hfs cd :}
	if {[do_dir] != 1} {
	    set dirpos($depth) $i;
	    incr depth;
	    set button_text $b;
	    set dirnames($depth) $button_text;
	    fillboxes;
	}
	.w configure -cursor top_left_arrow;
	return;
    } 
    if {$flag == "D"} {
	set d [lindex $names_list $i];
	set err [catch {exec $hfs cd $d} msg];
	if {$err == 1} {
	    errbox $msg;
	} else {
	    if {[do_dir] != 1} {
		set button_text $b;
		set dirpos($depth) $i;
		incr depth;
		set dirnames($depth) [iso_translate $d];
		fillboxes;
	    }
	}
	.w configure -cursor top_left_arrow;
	return;
    }
    .w configure -cursor top_left_arrow;
    display_or_copy $i;
}
proc display_or_copy {file} {
    global b;
    global names_list sizes_list type_creator_list actions;

    set name [lindex $names_list $file];
    set type [string range [lindex $type_creator_list $file] 0 3];
    set sizes [lindex $sizes_list $file];
    set dsize [string trim [string range $sizes 0 7]]; 
    set rsize [string trim [string range $sizes 11 end]];
    # create the dialog box: 1 = copy data,  2 = copy resource
    #    3 = display as text, 4 = display with program
    toplevel .d;
    wm title .d "show/copy file";
    if {$dsize != "0"} {
	button .d.b1 -text "Copy data fork" -command {set b 1} \
	    -padx 1m -pady 1m;
	pack .d.b1 -side left -expand yes  -ipadx 1m -ipady 1m;
    }
    if {$rsize != "0"} {
	button .d.b2 -text "Copy resource fork"  -command {set b 2} \
	    -padx 1m -pady 1m;
	pack .d.b2 -side left -expand yes -ipadx 1m -ipady 1m;
    }
    if {$dsize != "0" && ![info exists actions($type)]} {
	button .d.b3 -text "Display as text" -command {set b 3} \
	    -padx 1m -pady 1m;
	pack .d.b3 -side left -expand yes -ipadx 1m -ipady 1m;
    }
    if {[info exists actions($type)]} {
	button .d.b4 -text "Use default program"  -command {set b 4} \
	    -padx 1m -pady 1m;
	pack .d.b4 -side left -expand yes -ipadx 1m -ipady 1m;
    }
    button .d.b0 -text "Dismiss" -command {set b 0} -relief sunken -bd 1\
	    -padx 1m -pady 1m;
    frame .d.f -relief sunken -bd 1;
    raise .d.b0;
    pack .d.f -side left -expand yes -padx 1m -pady 1m;
    pack .d.b0 -side left -expand yes -padx 1m -pady 1m -ipadx 1m -ipady 1m\
	-in .d.f;
    bind .d <Return> {set b 1};
    set f [focus];
    focus .d;
    tkwait variable b;
    destroy .d;
    focus $f;
    switch $b {
	1 {copy_file data $file}
	2 {copy_file resource $file}
	3 {display_as_text $file}
	4 {use_program $actions($type) $file}
	default {}
    }
}
proc display_as_text {f} {
    global hfs names_list;

    set name [lindex $names_list $f];
    .w configure -cursor watch;
    update idletasks;
 
    set w ".tkhfs$f";
    catch {destroy $w};
    toplevel $w;
    wm title $w [iso_translate $name];
    wm minsize $w 1 1;
    frame $w.frame -borderwidth 10;
    scrollbar $w.frame.yscroll -relief sunken \
        -command "$w.frame.page yview";
    text $w.frame.page -yscroll "$w.frame.yscroll set" \
        -width 80 -height 30 -relief sunken -wrap word;
    pack $w.frame.yscroll -side right -fill y;
    pack $w.frame.page -side top -expand yes -fill both;

    if [catch {set contents [exec $hfs cat -t $name]} msg] {
	set contents $msg;
    }

    $w.frame.page insert 0.0 $contents;
    $w.frame.page configure -state disabled
    
    .w configure -cursor top_left_arrow;
    
    button $w.dismiss -text Dismiss -command "destroy $w"
    pack $w.frame -side top -fill both -expand yes
    pack $w.dismiss -side bottom -fill x
}
proc use_program {p f} {
    global names_list hfs;
    
    if {[string trim $p] == ""} {
	display_as_text $f;
    } else {
	set name [lindex $names_list $f];
	catch {eval exec $hfs cat {$name} | $p};
    }
}

proc about_tkhfs { } {
    global version;

    toplevel .about; 
    message .about.label -text \
	"tkhfs - a front end to hfs\n\
version $version\nwritten by Jean-Marc Zucconi\n\
(jmz@cabri.obs-besancon.fr)\n\n\
hfs was written by Craig Southeren\n\
(craigs@ineluki.apana.org.au)" \
	-justify center  -aspect 10000
    button .about.button -text "dismiss" -command "set i 1";
    pack .about.label -side top -padx 1m -pady 2m -fill x
    pack .about.button -expand yes -pady 1m
    tkwait variable i;
    destroy .about;
}
proc help_device { } {
    set text \
"hfs  defaults  to  using  /dev/rfd0.1440.   This  
can  be overridden  by specifying  a filename or
device via the  HFS_DEVICE environment variable.
Note  that the  device used  by does not have to 
be floppy drive.  It can  just as  easily be the
name of the CD-ROM  device, a normal file or any 
other accessible device. For instance, to access 
a CD-ROM, set the device to /dev/cd0d";
    display_text "device" $text;
}
proc help_config { } {
    set text \
"thkfs uses a  (optional) configuration file.  This
file contains  the default rules to display files. 
Lines  beginning  with '#' or  empty lines will be
ignored. Each line of the file is of the form
          TYPE command-line
TYPE  is the file  type in the  Finder terminology 
(eg TEXT for text files, PICT for images in 'pict'
format): it must  be 4  characters long,  case and
spaces are  significant.  The 5th  char must  be a
space and the remaining of the line is the command
to execute, as if you type 
       `cat the_mac_file | command-line'.
The program invoked in command-line should then be
able  to read its data from standard input. 
Here are a few examples:

 # mac PICT format. Translated using picttoppm and 
 #                  visualized with xv
 PICT  picttoppm | xv -

 # if no command given, the file's contents will be 
 # displayed in a text canvas
 TEXT    

 # a mac paint image, displayed with  xloadimage
 PNTG  xloadimage stdin

 # a `tiff' image, displayed with imagemagic.
 TIFF /home/ports/ImageMagic/display -

 # remember: case and spaces are significant
   nd6  /bin/true


If the environment variable TKHFS is defined, tkhfs 
will  use this  file as configuration file.  If the
variable does not exist, the  file `.tkhfs' will be
searched in your home directory.

X resources:  you can change the font  used by  the
file selector. 
For example  `tkhfs*listboxes*font: terminal18'  in
your  .Xdefaults  file will force  tkhfs to use the
font terminal18. You must choose a fixed font.";
    display_text "configure" $text;
}
proc display_text {head text} {

    set w ".help"

    catch {destroy $w}
    toplevel $w

    wm title $w $head
    frame $w.frame -borderwidth 10

    scrollbar $w.frame.yscroll -relief sunken \
        -command "$w.frame.page yview"
    text $w.frame.page -yscroll "$w.frame.yscroll set" \
        -width 52 -height 12 -relief sunken -wrap word
    pack $w.frame.yscroll -side right -fill y
    pack $w.frame.page -side top -expand 1 -fill both
    $w.frame.page insert 0.0 $text
    $w.frame.page configure -state disabled
    button $w.dismiss -text dismiss -command "destroy $w"
    pack $w.frame -side top -fill both -expand 1
    pack $w.dismiss -side bottom -fill x
}


source [info library]/FSBox.tcl;

proc copy_file {t f} {
    global names_list hfs;

    set name [lindex $names_list $f];
    if {$t != "data"} {
	set t "-R";
    } else {
	set t "";
    }
    set new [FSBox "Write to file:"];
    if {$new != ""} {
	catch {exec rm -f $new};
	exec $hfs read $t $name $new; 
    }
}
