#!/usr/local/bin/wish8.2 -f
# -*- tcl -*-

set version 1.27

#  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 /usr/local/bin/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];
}

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 j k} {
    global type_creator dr_sizes file_date;

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

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 \
    -width 2 -height 15
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 \
    -width 32 -height 15 -font $font
pack .w.listboxes.name -side left -expand yes -fill both -in .w.listboxes
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 \
	-width 12 -height 15 -font $font
    bind .w.listboxes.type_creator  <ButtonPress-1> " ";
}
if {$dr_sizes == 1} {
    listbox .w.listboxes.sizes -yscroll ".w.listboxes.scroll set" -relief groove \
	-width 18 -height 15 -font $font
    bind .w.listboxes.sizes  <ButtonPress-1> " ";
}
if {$file_date == 1} {
    listbox .w.listboxes.dates -yscroll ".w.listboxes.scroll set" -relief groove \
	-width 13 -height 15 -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
    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
    }
    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
    }
    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
    }
}

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 \
	    -width 18 -height 15 -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 \
	    -width 12 -height 15 -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 \
	    -width 13 -height 15 -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; 
    }
}
# XFNoParsing
# Program: template
# Description: file selector box
#
# $Header: /home/CVS/tkhfs/tkhfs,v 1.3 1996/10/10 00:58:52 jmz Exp $

global fsBox
set fsBox(activeBackground) ""
set fsBox(activeForeground) ""
set fsBox(background) ""
set fsBox(font) ""
set fsBox(foreground) ""
set fsBox(scrollActiveForeground) ""
set fsBox(scrollBackground) ""
set fsBox(scrollForeground) ""
set fsBox(scrollSide) left
set fsBox(showPixmap) 0
set fsBox(name) ""
set fsBox(path) [pwd]
set fsBox(pattern) *
set fsBox(all) 0
set fsBox(button) 0
set fsBox(extensions) 0
set fsBox(internalPath) [pwd]

proc FSBox {{fsBoxMessage "Select file:"} {fsBoxFileName ""} {fsBoxActionOk ""} {fsBoxActionCancel ""}} {# xf ignore me 5
##########
# Procedure: FSBox
# Description: show file selector box
# Arguments: fsBoxMessage - the text to display
#            fsBoxFileName - a file name that should be selected
#            fsBoxActionOk - the action that should be performed on ok
#            fsBoxActionCancel - the action that should be performed on cancel
# Returns: the filename that was selected, or nothing
# Sideeffects: none
##########
# 
# global fsBox(activeBackground) - active background color
# global fsBox(activeForeground) - active foreground color
# global fsBox(background) - background color
# global fsBox(font) - text font
# global fsBox(foreground) - foreground color
# global fsBox(extensions) - scan directory for extensions
# global fsBox(scrollActiveForeground) - scrollbar active background color
# global fsBox(scrollBackground) - scrollbar background color
# global fsBox(scrollForeground) - scrollbar foreground color
# global fsBox(scrollSide) - side where scrollbar is located

  global fsBox

  set tmpButtonOpt ""
  set tmpFrameOpt ""
  set tmpMessageOpt ""
  set tmpScaleOpt ""
  set tmpScrollOpt ""
  if {"$fsBox(activeBackground)" != ""} {
    append tmpButtonOpt "-activebackground \"$fsBox(activeBackground)\" "
  }
  if {"$fsBox(activeForeground)" != ""} {
    append tmpButtonOpt "-activeforeground \"$fsBox(activeForeground)\" "
  }
  if {"$fsBox(background)" != ""} {
    append tmpButtonOpt "-background \"$fsBox(background)\" "
    append tmpFrameOpt "-background \"$fsBox(background)\" "
    append tmpMessageOpt "-background \"$fsBox(background)\" "
  }
  if {"$fsBox(font)" != ""} {
    append tmpButtonOpt "-font \"$fsBox(font)\" "
    append tmpMessageOpt "-font \"$fsBox(font)\" "
  }
  if {"$fsBox(foreground)" != ""} {
    append tmpButtonOpt "-foreground \"$fsBox(foreground)\" "
    append tmpMessageOpt "-foreground \"$fsBox(foreground)\" "
  }
  if {"$fsBox(scrollActiveForeground)" != ""} {
    append tmpScrollOpt "-activeforeground \"$fsBox(scrollActiveForeground)\" "
  }
  if {"$fsBox(scrollBackground)" != ""} {
    append tmpScrollOpt "-background \"$fsBox(scrollBackground)\" "
  }
  if {"$fsBox(scrollForeground)" != ""} {
    append tmpScrollOpt "-foreground \"$fsBox(scrollForeground)\" "
  }

  if {[file exists [file tail $fsBoxFileName]] &&
      [IsAFile [file tail $fsBoxFileName]]} {
    set fsBox(name) [file tail $fsBoxFileName]
  } {
    set fsBox(name) ""
  }
  if {[file exists $fsBoxFileName] && [IsADir $fsBoxFileName]} {
    set fsBox(path) $fsBoxFileName
  } {
    if {"[file rootname $fsBoxFileName]" != "."} {
      set fsBox(path) [file rootname $fsBoxFileName]
    }
  }
  if {$fsBox(showPixmap)} {
    set fsBox(path) [string trimleft $fsBox(path) @]
  }
  if {"$fsBox(path)" != "" && [file exists $fsBox(path)] &&
      [IsADir $fsBox(path)]} {
    set fsBox(internalPath) $fsBox(path)
  } {
    if {"$fsBox(internalPath)" == "" ||
        ![file exists $fsBox(internalPath)]} {
      set fsBox(internalPath) [pwd]
    }
  }
  # build widget structure

  # start build of toplevel
  if {"[info commands XFDestroy]" != ""} {
    catch {XFDestroy .fsBox}
  } {
    catch {destroy .fsBox}
  }
  toplevel .fsBox \
    -borderwidth 0
  catch ".fsBox config $tmpFrameOpt"
  wm geometry .fsBox 350x300 
  wm title .fsBox {File select box}
  wm maxsize .fsBox 1000 1000
  wm minsize .fsBox 100 100
  # end build of toplevel

  label .fsBox.message1 \
    -anchor c \
    -relief raised \
    -text "$fsBoxMessage"
  catch ".fsBox.message1 config $tmpMessageOpt"

  frame .fsBox.frame1 \
    -borderwidth 0 \
    -relief raised
  catch ".fsBox.frame1 config $tmpFrameOpt"

  button .fsBox.frame1.ok \
    -text "OK" \
    -command "
      global fsBox
      set fsBox(name) \[.fsBox.file.file get\]
      if {$fsBox(showPixmap)} {
        set fsBox(path) @\[.fsBox.path.path get\]
      } {
        set fsBox(path) \[.fsBox.path.path get\]
      }
      set fsBox(internalPath) \[.fsBox.path.path get\]
      $fsBoxActionOk
      if {\"\[info commands XFDestroy\]\" != \"\"} {
        catch {XFDestroy .fsBox}
      } {
        catch {destroy .fsBox}
      }"
  catch ".fsBox.frame1.ok config $tmpButtonOpt"

  button .fsBox.frame1.rescan \
    -text "Rescan" \
    -command {
      global fsBox
      FSBoxFSShow [.fsBox.path.path get] \
        [.fsBox.pattern.pattern get] $fsBox(all)}
  catch ".fsBox.frame1.rescan config $tmpButtonOpt"

  button .fsBox.frame1.cancel \
    -text "Cancel" \
    -command "
      global fsBox
      set fsBox(name) {}
      set fsBox(path) {}
      $fsBoxActionCancel
      if {\"\[info commands XFDestroy\]\" != \"\"} {
        catch {XFDestroy .fsBox}
      } {
        catch {destroy .fsBox}
      }"
  catch ".fsBox.frame1.cancel config $tmpButtonOpt"

  if {$fsBox(showPixmap)} {
    frame .fsBox.frame2 \
      -borderwidth 0 \
      -relief raised
    catch ".fsBox.frame2 config $tmpFrameOpt"

    scrollbar .fsBox.frame2.scrollbar3 \
      -command {.fsBox.frame2.canvas2 xview} \
      -orient {horizontal} \
      -relief {raised}
    catch ".fsBox.frame2.scrollbar3 config $tmpScrollOpt"

    scrollbar .fsBox.frame2.scrollbar1 \
      -command {.fsBox.frame2.canvas2 yview} \
      -relief {raised}
    catch ".fsBox.frame2.scrollbar1 config $tmpScrollOpt"

    canvas .fsBox.frame2.canvas2 \
      -confine {true} \
      -relief {raised} \
      -scrollregion {0c 0c 20c 20c} \
      -width {100} \
      -xscrollcommand {.fsBox.frame2.scrollbar3 set} \
      -yscrollcommand {.fsBox.frame2.scrollbar1 set}
    catch ".fsBox.frame2.canvas2 config $tmpFrameOpt"

    .fsBox.frame2.canvas2 addtag currentBitmap withtag [.fsBox.frame2.canvas2 create bitmap 5 5 -anchor nw]
  }

  frame .fsBox.path \
    -borderwidth 0 \
    -relief raised
  catch ".fsBox.path config $tmpFrameOpt"

  frame .fsBox.path.paths \
    -borderwidth 2 \
    -relief raised
  catch ".fsBox.path.paths config $tmpFrameOpt"

  menubutton .fsBox.path.paths.paths \
    -borderwidth 0 \
    -menu ".fsBox.path.paths.paths.menu" \
    -relief flat \
    -text "Pathname:"
  catch ".fsBox.path.paths.paths config $tmpButtonOpt"

  menu .fsBox.path.paths.paths.menu
  catch ".fsBox.path.paths.paths.menu config $tmpButtonOpt"

  .fsBox.path.paths.paths.menu add command \
     -label "[string trimright $fsBox(internalPath) {/@}]" \
     -command "
       global fsBox
       FSBoxFSShow \[.fsBox.path.path get\] \
         \[.fsBox.pattern.pattern get\] \$fsBox(all)
       .fsBox.path.path delete 0 end
       .fsBox.path.path insert 0 [string trimright $fsBox(internalPath) {/@}]"

  entry .fsBox.path.path \
    -relief raised
  catch ".fsBox.path.path config $tmpMessageOpt"

  if {![IsADir $fsBox(internalPath)]} {
    set $fsBox(internalPath) [pwd]
  }
  .fsBox.path.path insert 0 $fsBox(internalPath)

  frame .fsBox.pattern \
    -borderwidth 0 \
    -relief raised
  catch ".fsBox.pattern config $tmpFrameOpt"

  frame .fsBox.pattern.patterns \
    -borderwidth 2 \
    -relief raised
  catch ".fsBox.pattern.patterns config $tmpFrameOpt"

  menubutton .fsBox.pattern.patterns.patterns \
    -borderwidth 0 \
    -menu ".fsBox.pattern.patterns.patterns.menu" \
    -relief flat \
    -text "Selection pattern:"
  catch ".fsBox.pattern.patterns.patterns config $tmpButtonOpt"

  menu .fsBox.pattern.patterns.patterns.menu
  catch ".fsBox.pattern.patterns.patterns.menu config $tmpButtonOpt"

  .fsBox.pattern.patterns.patterns.menu add checkbutton \
    -label "Scan extensions" \
    -variable fsBoxExtensions \
    -command {
      global fsBox
      FSBoxFSShow [.fsBox.path.path get] \
        [.fsBox.pattern.pattern get] $fsBox(all)}

  entry .fsBox.pattern.pattern \
    -relief raised
  catch ".fsBox.pattern.pattern config $tmpMessageOpt"

  .fsBox.pattern.pattern insert 0 $fsBox(pattern)
  
  frame .fsBox.files \
    -borderwidth 0 \
    -relief raised
  catch ".fsBox.files config $tmpFrameOpt"

  scrollbar .fsBox.files.vscroll \
    -relief raised \
    -command ".fsBox.files.files yview"
  catch ".fsBox.files.vscroll config $tmpScrollOpt"

  scrollbar .fsBox.files.hscroll \
    -orient horiz \
    -relief raised \
    -command ".fsBox.files.files xview"
  catch ".fsBox.files.hscroll config $tmpScrollOpt"

  listbox .fsBox.files.files \
    -exportselection false \
    -relief raised \
    -xscrollcommand ".fsBox.files.hscroll set" \
    -yscrollcommand ".fsBox.files.vscroll set"
  catch ".fsBox.files.files config $tmpMessageOpt"

  frame .fsBox.file \
    -borderwidth 0 \
    -relief raised
  catch ".fsBox.file config $tmpFrameOpt"

  label .fsBox.file.labelfile \
    -relief raised \
    -text "Filename:"
  catch ".fsBox.file.labelfile config $tmpMessageOpt"

  entry .fsBox.file.file \
    -relief raised
  catch ".fsBox.file.file config $tmpMessageOpt"

  .fsBox.file.file delete 0 end
  .fsBox.file.file insert 0 $fsBox(name)
  
  checkbutton .fsBox.pattern.all \
    -offvalue 0 \
    -onvalue 1 \
    -text "Show all files" \
    -variable fsBox(all) \
    -command {
      global fsBox
      FSBoxFSShow [.fsBox.path.path get] \
        [.fsBox.pattern.pattern get] $fsBox(all)}
  catch ".fsBox.pattern.all config $tmpButtonOpt"

  FSBoxFSShow $fsBox(internalPath) $fsBox(pattern) $fsBox(all)

  # bindings
  bind .fsBox.files.files <Double-Button-1> "
    FSBoxFSFileSelectDouble %W $fsBox(showPixmap) \{$fsBoxActionOk\} %y"
  bind .fsBox.files.files <ButtonPress-1> "
    FSBoxFSFileSelect %W $fsBox(showPixmap) %y"
  bind .fsBox.files.files <Button1-Motion> "
    FSBoxFSFileSelect %W $fsBox(showPixmap) %y"
  bind .fsBox.files.files <Shift-Button1-Motion> "
    FSBoxFSFileSelect %W $fsBox(showPixmap) %y"
  bind .fsBox.files.files <Shift-ButtonPress-1> "
    FSBoxFSFileSelect %W $fsBox(showPixmap) %y"

  bind .fsBox.path.path <Tab> {
    FSBoxFSNameComplete path}
  bind .fsBox.path.path <Return> {
    global tkVersion
    global fsBox
    FSBoxFSShow [.fsBox.path.path get] \
      [.fsBox.pattern.pattern get] $fsBox(all)
    FSBoxFSInsertPath
    if {$tkVersion >= 3.0} {
      .fsBox.file.file icursor end
    } {
      .fsBox.file.file cursor end
    }
    focus .fsBox.file.file}
  catch "bind .fsBox.path.path <Up> {}"
  bind .fsBox.path.path <Down> {
    global tkVersion
    if {$tkVersion >= 3.0} {
      .fsBox.file.file icursor end
    } {
      .fsBox.file.file cursor end
    }
    focus .fsBox.file.file}

  bind .fsBox.file.file <Tab> {
    FSBoxFSNameComplete file}
  bind .fsBox.file.file <Return> "
    global fsBox
    set fsBox(name) \[.fsBox.file.file get\]
    if {$fsBox(showPixmap)} {
      set fsBox(path) @\[.fsBox.path.path get\]
    } {
      set fsBox(path) \[.fsBox.path.path get\]
    }
    set fsBox(internalPath) \[.fsBox.path.path get\]
    $fsBoxActionOk
    if {\"\[info commands XFDestroy\]\" != \"\"} {
      catch {XFDestroy .fsBox}
    } {
      catch {destroy .fsBox}
    }"
  bind .fsBox.file.file <Up> {
    global tkVersion
    if {$tkVersion >= 3.0} {
      .fsBox.path.path icursor end
    } {
      .fsBox.path.path cursor end
    }
    focus .fsBox.path.path}
  bind .fsBox.file.file <Down> {
    global tkVersion
    if {$tkVersion >= 3.0} {
      .fsBox.pattern.pattern icursor end
    } {
      .fsBox.pattern.pattern cursor end
    }
    focus .fsBox.pattern.pattern}

  bind .fsBox.pattern.pattern <Return> {
    global fsBox
    FSBoxFSShow [.fsBox.path.path get] \
      [.fsBox.pattern.pattern get] $fsBox(all)}
  bind .fsBox.pattern.pattern <Up> {
    global tkVersion
    if {$tkVersion >= 3.0} {
      .fsBox.file.file icursor end
    } {
      .fsBox.file.file cursor end
    }
    focus .fsBox.file.file}
  catch "bind .fsBox.pattern.pattern <Down> {}"

  # packing
  pack append .fsBox.files \
              .fsBox.files.vscroll "$fsBox(scrollSide) filly" \
              .fsBox.files.hscroll {bottom fillx} \
              .fsBox.files.files {left fill expand}
  pack append .fsBox.file \
              .fsBox.file.labelfile {left} \
              .fsBox.file.file {left fill expand}
  pack append .fsBox.frame1 \
              .fsBox.frame1.ok {left fill expand} \
              .fsBox.frame1.rescan {left fill expand} \
              .fsBox.frame1.cancel {left fill expand}
  pack append .fsBox.path.paths \
              .fsBox.path.paths.paths {left}
  pack append .fsBox.pattern.patterns \
              .fsBox.pattern.patterns.patterns {left}
  pack append .fsBox.path \
              .fsBox.path.paths {left} \
              .fsBox.path.path {left fill expand}
  pack append .fsBox.pattern \
              .fsBox.pattern.patterns {left} \
              .fsBox.pattern.all {right fill} \
              .fsBox.pattern.pattern {left fill expand}
  if {$fsBox(showPixmap)} {
    pack append .fsBox.frame2 \
                .fsBox.frame2.scrollbar1 {left filly} \
                .fsBox.frame2.canvas2 {top expand fill} \
                .fsBox.frame2.scrollbar3 {top fillx} 

    pack append .fsBox \
                .fsBox.message1 {top fill} \
                .fsBox.frame1 {bottom fill} \
                .fsBox.pattern {bottom fill} \
                .fsBox.file {bottom fill} \
                .fsBox.path {bottom fill} \
                .fsBox.frame2 {right fill} \
                .fsBox.files {left fill expand}
  } {
    pack append .fsBox \
                .fsBox.message1 {top fill} \
                .fsBox.frame1 {bottom fill} \
                .fsBox.pattern {bottom fill} \
                .fsBox.file {bottom fill} \
                .fsBox.path {bottom fill} \
                .fsBox.files {left fill expand}
  }

  if {"$fsBoxActionOk" == "" && "$fsBoxActionCancel" == ""} {
    # wait for the box to be destroyed
    update idletask
    grab .fsBox
    tkwait window .fsBox

    if {"[string trim $fsBox(path)]" != "" ||
        "[string trim $fsBox(name)]" != ""} {
      if {"[string trimleft [string trim $fsBox(name)] /]" == ""} {
        return [string trimright [string trim $fsBox(path)] /]
      } {
        return [string trimright [string trim $fsBox(path)] /]/[string trimleft [string trim $fsBox(name)] /]
      }
    }
  }
}

##########
# Procedure: FSBoxFSFileSelect
# Description: select file name
# Arguments: fsBoxW - the widget
#            fsBoxShowPixmap - show pixmaps
#            fsBoxY - the y position in the listbox
# Returns: none
# Sideeffects: none
##########
proc FSBoxFSFileSelect {fsBoxW fsBoxShowPixmap fsBoxY} {# xf ignore me 6
  global fsBox

  FSBoxBindSelectOne $fsBoxW $fsBoxY
  set fsBoxNearest [$fsBoxW nearest $fsBoxY]
  if {$fsBoxNearest >= 0} {
    set fsBoxTmpEntry [$fsBoxW get $fsBoxNearest]
    if {"[string index $fsBoxTmpEntry \
          [expr [string length $fsBoxTmpEntry]-1]]" == "/" ||
        "[string index $fsBoxTmpEntry \
          [expr [string length $fsBoxTmpEntry]-1]]" == "@"} {
      set fsBoxFileName [string range $fsBoxTmpEntry 0 \
            [expr [string length $fsBoxTmpEntry]-2]]
      if {![IsADir [string trimright $fsBox(internalPath)/$fsBoxFileName @]] &&
          ![IsASymlink [string trimright $fsBox(internalPath)/$fsBoxFileName @]]} {
        set fsBoxFileName $fsBoxTmpEntry
      }
    } {
      if {"[string index $fsBoxTmpEntry \
            [expr [string length $fsBoxTmpEntry]-1]]" == "*"} {
        set fsBoxFileName [string range $fsBoxTmpEntry 0 \
          [expr [string length $fsBoxTmpEntry]-2]]
        if {![file executable $fsBox(internalPath)/$fsBoxFileName]} {
          set fsBoxFileName $fsBoxTmpEntry
        }
      } {
        set fsBoxFileName $fsBoxTmpEntry
      }
    }
    if {![IsADir [string trimright $fsBox(internalPath)/$fsBoxFileName @]]} {
      set fsBox(name) $fsBoxFileName
      .fsBox.file.file delete 0 end
      .fsBox.file.file insert 0 $fsBox(name)
      if {$fsBoxShowPixmap} {
        catch ".fsBox.frame2.canvas2 itemconfigure currentBitmap -bitmap \"@$fsBox(internalPath)/$fsBox(name)\""
      }
    }
  }
}

##########
# Procedure: FSBoxFSFileSelectDouble
# Description: select file when double clicked
# Arguments: fsBoxW - the widget
#            fsBoxShowPixmap - show pixmaps
#            fsBoxAction - the action bound to the ok button
#            fsBoxY - the y position in the listbox
# Returns: none
# Sideeffects: none
##########
proc FSBoxFSFileSelectDouble {fsBoxW fsBoxShowPixmap fsBoxAction fsBoxY} {# xf ignore me 6
  global fsBox

  FSBoxBindSelectOne $fsBoxW $fsBoxY
  set fsBoxNearest [$fsBoxW nearest $fsBoxY]
  if {$fsBoxNearest >= 0} {
    set fsBoxTmpEntry [$fsBoxW get $fsBoxNearest]
    if {"$fsBoxTmpEntry" == "../"} {
      set fsBoxTmpEntry [string trimright [string trim $fsBox(internalPath)] "@/"]
      if {"$fsBoxTmpEntry" == ""} {
        return
      }
      FSBoxFSShow [file dirname $fsBoxTmpEntry] \
        [.fsBox.pattern.pattern get] $fsBox(all)
      .fsBox.path.path delete 0 end
      .fsBox.path.path insert 0 $fsBox(internalPath)
    } {
      if {"[string index $fsBoxTmpEntry \
            [expr [string length $fsBoxTmpEntry]-1]]" == "/" ||
          "[string index $fsBoxTmpEntry \
            [expr [string length $fsBoxTmpEntry]-1]]" == "@"} {
        set fsBoxFileName [string range $fsBoxTmpEntry 0 \
              [expr [string length $fsBoxTmpEntry]-2]]
        if {![IsADir [string trimright $fsBox(internalPath)/$fsBoxFileName @]] &&
            ![IsASymlink [string trimright $fsBox(internalPath)/$fsBoxFileName @]]} {
          set fsBoxFileName $fsBoxTmpEntry
        }
      } {
        if {"[string index $fsBoxTmpEntry \
              [expr [string length $fsBoxTmpEntry]-1]]" == "*"} {
          set fsBoxFileName [string range $fsBoxTmpEntry 0 \
                [expr [string length $fsBoxTmpEntry]-2]]
          if {![file executable $fsBox(internalPath)/$fsBoxFileName]} {
            set fsBoxFileName $fsBoxTmpEntry
          }
        } {
          set fsBoxFileName $fsBoxTmpEntry
        }
      }
      if {[IsADir [string trimright $fsBox(internalPath)/$fsBoxFileName @]]} {
        set fsBox(internalPath) "[string trimright $fsBox(internalPath) {/@}]/$fsBoxFileName"
        FSBoxFSShow $fsBox(internalPath) \
          [.fsBox.pattern.pattern get] $fsBox(all)
        .fsBox.path.path delete 0 end
        .fsBox.path.path insert 0 $fsBox(internalPath)
      } {
        set fsBox(name) $fsBoxFileName
        if {$fsBoxShowPixmap} {
          set fsBox(path) @$fsBox(internalPath)
        } {
          set fsBox(path) $fsBox(internalPath)
        }
        if {"$fsBoxAction" != ""} {
          eval "global fsBox; $fsBoxAction"
        }
        if {"[info commands XFDestroy]" != ""} {
          catch {XFDestroy .fsBox}
        } {
          catch {destroy .fsBox}
        }
      }
    }
  }
}

##########
# Procedure: FSBoxFSInsertPath
# Description: insert current pathname into menu
# Arguments: none
# Returns: none
# Sideeffects: none
##########
proc FSBoxFSInsertPath {} {# xf ignore me 6
  global fsBox

  set fsBoxLast [.fsBox.path.paths.paths.menu index last]
  set fsBoxNewEntry [string trimright [.fsBox.path.path get] "/@"]
  for {set fsBoxCounter 0} {$fsBoxCounter <= $fsBoxLast} {incr fsBoxCounter 1} {
    if {"$fsBoxNewEntry" == \
          "[lindex [.fsBox.path.paths.paths.menu entryconfigure \
                    $fsBoxCounter -label] 4]"} {
      return
    }
  }
  if {$fsBoxLast < 9} {
    .fsBox.path.paths.paths.menu add command \
      -label "$fsBoxNewEntry" \
      -command "
        global fsBox
        FSBoxFSShow $fsBoxNewEntry \
          \[.fsBox.pattern.pattern get\] \$fsBox(all)
        .fsBox.path.path delete 0 end
        .fsBox.path.path insert 0 $fsBoxNewEntry"
  } {
    for {set fsBoxCounter 0} {$fsBoxCounter < $fsBoxLast} {incr fsBoxCounter 1} {
      .fsBox.path.paths.paths.menu entryconfigure \
        $fsBoxCounter -label \
          [lindex [.fsBox.path.paths.paths.menu entryconfigure \
            [expr $fsBoxCounter+1] -label] 4]
      .fsBox.path.paths.paths.menu entryconfigure $fsBoxCounter \
        -command "
          global fsBox
          FSBoxFSShow [lindex [.fsBox.path.paths.paths.menu entryconfigure \
            [expr $fsBoxCounter+1] -label] 4] \
            \[.fsBox.pattern.pattern get\] \$fsBox(all)
          .fsBox.path.path delete 0 end
          .fsBox.path.path insert 0 [lindex \
            [.fsBox.path.paths.paths.menu entryconfigure \
              [expr $fsBoxCounter+1] -label] 4]"
    }
    .fsBox.path.paths.paths.menu entryconfigure $fsBoxLast \
      -label "$fsBoxNewEntry"
    .fsBox.path.paths.paths.menu entryconfigure $fsBoxCounter \
      -command "
        global fsBox
        FSBoxFSShow \[.fsBox.path.path get\] \
          \[.fsBox.pattern.pattern get\] \$fsBox(all)
        .fsBox.path.path delete 0 end
        .fsBox.path.path insert 0 $fsBoxNewEntry"
  }
}

##########
# Procedure: FSBoxFSNameComplete
# Description: perform name completion for fs box
# Arguments: fsBoxType - the type we want to complete (path or file)
# Returns: none
# Sideeffects: none
##########
proc FSBoxFSNameComplete {fsBoxType} {# xf ignore me 6
  global tkVersion
  global fsBox

  set fsBoxNewFile ""
  if {"$fsBoxType" == "path"} {
    set fsBoxDirName [file dirname [.fsBox.path.path get]]
    set fsBoxFileName [file tail [.fsBox.path.path get]]
  } {
    set fsBoxDirName [file dirname [.fsBox.path.path get]/]
    set fsBoxFileName [file tail [.fsBox.file.file get]]
  }

  set fsBoxNewFile ""
  if {[IsADir [string trimright $fsBoxDirName @]]} {
    catch "glob -nocomplain $fsBoxDirName/${fsBoxFileName}*" fsBoxResult
    foreach fsBoxCounter $fsBoxResult {
      if {"$fsBoxNewFile" == ""} {
        set fsBoxNewFile [file tail $fsBoxCounter]
      } {
        if {"[string index [file tail $fsBoxCounter] 0]" !=
            "[string index $fsBoxNewFile 0]"} {
          set fsBoxNewFile ""
          break
        }
        set fsBoxCounter1 0
        set fsBoxTmpFile1 $fsBoxNewFile
        set fsBoxTmpFile2 [file tail $fsBoxCounter]
        set fsBoxLength1 [string length $fsBoxTmpFile1]
        set fsBoxLength2 [string length $fsBoxTmpFile2]
        set fsBoxNewFile ""
        if {$fsBoxLength1 > $fsBoxLength2} {
          set fsBoxLength1 $fsBoxLength2
        }
        while {$fsBoxCounter1 < $fsBoxLength1} {
          if {"[string index $fsBoxTmpFile1 $fsBoxCounter1]" == \
                "[string index $fsBoxTmpFile2 $fsBoxCounter1]"} {
            append fsBoxNewFile [string index $fsBoxTmpFile1 $fsBoxCounter1]
          } {
            break
          }
          incr fsBoxCounter1 1
        }
      }
    }
  }
  if {"$fsBoxNewFile" != ""} {
    if {[IsADir [string trimright $fsBoxDirName/$fsBoxNewFile @]] ||
        ![IsAFile [string trimright $fsBoxDirName/$fsBoxNewFile @]]} {
      if {[IsADir [string trimright $fsBoxDirName/$fsBoxNewFile @]]} {
        if {"$fsBoxDirName" == "/"} {
          .fsBox.path.path delete 0 end
          .fsBox.path.path insert 0 "/[string trimright [string trim $fsBoxNewFile /] @]/"
        } {
          .fsBox.path.path delete 0 end
          .fsBox.path.path insert 0 "[string trimright $fsBoxDirName /]/[string trimright [string trim $fsBoxNewFile /] @]/"
        }
        FSBoxFSShow [.fsBox.path.path get] \
          [.fsBox.pattern.pattern get] $fsBox(all)
        FSBoxFSInsertPath
      } {
        .fsBox.path.path delete 0 end
        .fsBox.path.path insert 0 "[string trimright $fsBoxDirName /]/[string trimright [string trim $fsBoxNewFile /] @]"
      }
    } {
      .fsBox.path.path delete 0 end
      .fsBox.path.path insert 0 "[string trimright $fsBoxDirName {@/}]/"
      .fsBox.file.file delete 0 end
      .fsBox.file.file insert 0 $fsBoxNewFile
      if {$tkVersion >= 3.0} {
        .fsBox.file.file icursor end
      } {
        .fsBox.file.file cursor end
      }
      focus .fsBox.file.file
    }
  }
}

##########
# Procedure: FSBoxFSShow
# Description: show the file list
# Arguments: fsBoxPath - the path to show
#            fsBoxPattern - selection pattern
#            fsBoxAll - show all files
# Returns: none
# Sideeffects: none
##########
proc FSBoxFSShow {fsBoxPath fsBoxPattern fsBoxAll} {# xf ignore me 6
  global fsBox

  set tmpButtonOpt ""
  if {"$fsBox(activeBackground)" != ""} {
    append tmpButtonOpt "-activebackground \"$fsBox(activeBackground)\" "
  }
  if {"$fsBox(activeForeground)" != ""} {
    append tmpButtonOpt "-activeforeground \"$fsBox(activeForeground)\" "
  }
  if {"$fsBox(background)" != ""} {
    append tmpButtonOpt "-background \"$fsBox(background)\" "
  }
  if {"$fsBox(font)" != ""} {
    append tmpButtonOpt "-font \"$fsBox(font)\" "
  }
  if {"$fsBox(foreground)" != ""} {
    append tmpButtonOpt "-foreground \"$fsBox(foreground)\" "
  }

  set fsBox(pattern) $fsBoxPattern
  if {[file exists $fsBoxPath] && [file readable $fsBoxPath] &&
      [IsADir $fsBoxPath]} {
    set fsBox(internalPath) $fsBoxPath
  } {
    if {[file exists $fsBoxPath] && [file readable $fsBoxPath] &&
        [IsAFile $fsBoxPath]} {
      set fsBox(internalPath) [file dirname $fsBoxPath]
      .fsBox.file.file delete 0 end
      .fsBox.file.file insert 0 [file tail $fsBoxPath]
      set fsBoxPath $fsBox(internalPath)
    } {
      while {"$fsBoxPath" != "" && "$fsBoxPath" != "/" &&
             ![file isdirectory $fsBoxPath]} {
        set fsBox(internalPath) [file dirname $fsBoxPath]
         set fsBoxPath $fsBox(internalPath)
      }
    }
  }
  if {"$fsBoxPath" == ""} {
    set fsBoxPath "/"
    set fsBox(internalPath) "/"
  }
  .fsBox.path.path delete 0 end
  .fsBox.path.path insert 0 $fsBox(internalPath)

  if {[.fsBox.files.files size] > 0} {
    .fsBox.files.files delete 0 end
  }
  if {$fsBoxAll} {
    if {[catch "exec ls -F -a $fsBoxPath" fsBoxResult]} {
      puts stderr "$fsBoxResult"
    }
  } {
    if {[catch "exec ls -F $fsBoxPath" fsBoxResult]} {
      puts stderr "$fsBoxResult"
    }
  }
  set fsBoxElementList [lsort $fsBoxResult]

  foreach fsBoxCounter [winfo children .fsBox.pattern.patterns.patterns] {
    if {[string length [info commands XFDestroy]] > 0} {
      catch {XFDestroy $fsBoxCounter}
    } {
      catch {destroy $fsBoxCounter}
    }
  }
  menu .fsBox.pattern.patterns.patterns.menu
  catch ".fsBox.pattern.patterns.patterns.menu config $tmpButtonOpt"

  if {$fsBox(extensions)} {
    .fsBox.pattern.patterns.patterns.menu add command \
      -label "*" \
      -command {
        global fsBox
        set fsBox(pattern) "*"
        .fsBox.pattern.pattern delete 0 end
        .fsBox.pattern.pattern insert 0 $fsBox(pattern)
        FSBoxFSShow [.fsBox.path.path get] $fsBox(pattern) \
          $fsBox(all)}
  }

  if {"$fsBoxPath" != "/"} {
    .fsBox.files.files insert end "../"
  }
  foreach fsBoxCounter $fsBoxElementList {
    if {[string match $fsBoxPattern $fsBoxCounter] ||
        [IsADir [string trimright $fsBoxPath/$fsBoxCounter "/@"]]} {
      if {"$fsBoxCounter" != "../" &&
          "$fsBoxCounter" != "./"} {
        .fsBox.files.files insert end $fsBoxCounter
      }
    }

    if {$fsBox(extensions)} {
      catch "file rootname $fsBoxCounter" fsBoxRootName
      catch "file extension $fsBoxCounter" fsBoxExtension
      set fsBoxExtension [string trimright $fsBoxExtension "/*@"]
      if {"$fsBoxExtension" != "" && "$fsBoxRootName" != ""} {
        set fsBoxInsert 1
        set fsBoxLast [.fsBox.pattern.patterns.patterns.menu index last]
        for {set fsBoxCounter1 0} {$fsBoxCounter1 <= $fsBoxLast} {incr fsBoxCounter1 1} {
          if {"*$fsBoxExtension" == \
                "[lindex [.fsBox.pattern.patterns.patterns.menu entryconfigure \
                        $fsBoxCounter1 -label] 4]"} {
            set fsBoxInsert 0
          }
        }
	if {$fsBoxInsert} {
          .fsBox.pattern.patterns.patterns.menu add command \
            -label "*$fsBoxExtension" \
            -command "
              global fsBox
              set fsBox(pattern) \"*$fsBoxExtension\"
              .fsBox.pattern.pattern delete 0 end
              .fsBox.pattern.pattern insert 0 \$fsBox(pattern)
              FSBoxFSShow \[.fsBox.path.path get\] \$fsBox(pattern) \
                \$fsBox(all)"
        }
      }
    }
  }
  if {$fsBox(extensions)} {
    .fsBox.pattern.patterns.patterns.menu add separator
  }
  if {$fsBox(extensions) || 
      "[.fsBox.pattern.patterns.patterns.menu index last]" == "none"} {
    .fsBox.pattern.patterns.patterns.menu add checkbutton \
      -label "Scan extensions" \
      -variable "fsBox(extensions)" \
      -command {
        global fsBox
        FSBoxFSShow [.fsBox.path.path get] \
          [.fsBox.pattern.pattern get] $fsBox(all)}
  }
}

##########
# Procedure: FSBoxBindSelectOne
# Description: action to select the current list item
# Arguments: fsBoxW - the widget
#            fsBoxY - the y position in the listbox
# Returns: none
# Sideeffects: none
##########
proc FSBoxBindSelectOne {fsBoxW fsBoxY} {# xf ignore me 6

  set fsBoxNearest [$fsBoxW nearest $fsBoxY]
  if {$fsBoxNearest >= 0} {
    $fsBoxW select from $fsBoxNearest
    $fsBoxW select to $fsBoxNearest
  }
}

proc IsADir {pathName} {# xf ignore me 5
##########
# Procedure: IsADir
# Description: check if name is a directory (including symbolic links)
# Arguments: pathName - the path to check
# Returns: 1 if its a directory, otherwise 0
# Sideeffects: none
##########

  if {[file isdirectory $pathName]} {
    return 1
  } {
    catch "file type $pathName" fileType
    if {"$fileType" == "link"} {
      if {[catch "file readlink $pathName" linkName]} {
        return 0
      }
      catch "file type $linkName" fileType
      while {"$fileType" == "link"} {
        if {[catch "file readlink $linkName" linkName]} {
          return 0
        }
        catch "file type $linkName" fileType
      }
      return [file isdirectory $linkName]
    }
  }
  return 0
}

proc IsAFile {fileName} {# xf ignore me 5
##########
# Procedure: IsAFile
# Description: check if filename is a file (including symbolic links)
# Arguments: fileName - the filename to check
# Returns: 1 if its a file, otherwise 0
# Sideeffects: none
##########

  if {[file isfile $fileName]} {
    return 1
  } {
    catch "file type $fileName" fileType
    if {"$fileType" == "link"} {
      if {[catch "file readlink $fileName" linkName]} {
        return 0
      }
      catch "file type $linkName" fileType
      while {"$fileType" == "link"} {
        if {[catch "file readlink $linkName" linkName]} {
          return 0
        }
        catch "file type $linkName" fileType
      }
      return [file isfile $linkName]
    }
  }
  return 0
}

proc IsASymlink {fileName} {# xf ignore me 5
##########
# Procedure: IsASymlink
# Description: check if filename is a symbolic link
# Arguments: fileName - the path/filename to check
# Returns: none
# Sideeffects: none
##########

  catch "file type $fileName" fileType
  if {"$fileType" == "link"} {
    return 1
  }
  return 0
}

# eof

