package provide XF_Dialogs 1.0
package require FTP
proc SelectFont {{font fixed} {xoffset -300} {yoffset -150} {X {}} {Y {}}} {
    global fsrc

    catch {destroy .self}
    set w [toplevel .self]
    if {[option get .xfiles messages_always_on_top {}] == 1} {
	bind $w <Visibility> [list KeepOnTop $w %W %s]
    }
    wm withdraw $w
    if {[string compare {} $X] == 0} {
	set x [expr {[winfo pointerx .] + $xoffset}]
	set y [expr {[winfo pointery .] + $yoffset}]
    } {
	set x [expr {$X + $xoffset}]
	set y [expr {$Y + $yoffset}]
    }
    wm geometry $w "+$x+$y"
    wm title $w "X-Files Font Selector v0.2"
    wm resizable $w 0 0

    frame $w.l -bd 2 -relief ridge
    frame $w.b -bd 4 -relief raised

    label $w.c -anchor w
    pack $w.c -side top -fill x -expand 1

    listbox $w.l.lb -yscrollcommand [list $w.l.sy set] \
	    -selectbackground "#dfdf0f" -setgrid 1 \
	    -font fixed -width 75
    scrollbar $w.l.sy -orient vertical -command \
	    [list $w.l.lb yview] -relief ridge
    pack $w.l.lb -side left -fill both -expand 1
    pack $w.l.sy -side left -fill y
    pack $w.l -side top -fill both -expand 1

    label $w.n -font fixed -justify center
    pack $w.n -fill x -expand 1
    text $w.t -bd 3 -relief ridge -height 7 -width 50 -wrap none -pady 5
    pack $w.t -side top -fill x
    $w.t insert 0.0 "ABCDEFGHIJKLMNOPQRSTUVXYZ\nabcdefghijklmnopqrstuvxyz\n0123456789"
    $w.t tag add TEXT 0.0 end
    $w.t tag configure TEXT -justify center

    button $w.b.ok -text "Select" -width 6 -command {set fsrc 1}
    button $w.b.cancle -text "Cancel" -width 6 -command {set fsrc 0}
    pack $w.b.ok -side left -padx 10 -pady 10
    pack $w.b.cancle -side right -padx 10 -pady 10
    pack $w.b -side top -fill x -expand 1

    bind $w <Control-c> {set fsrc 0}
    bind $w <Escape> {set fsrc 0}
    bind $w.l.lb <ButtonRelease-1> {SF_Select .self [%W nearest %y] [%W get [%W nearest %y]]}
    bind $w.l.lb <Double-Button-1> {.self.b.ok flash; set fsrc 1}
    bind $w.l.lb <Key> {
	switch %K {
	    Up -
	    Down {
		set sel [%W curselection]
		if [string match Up %K] {set i -1} {set i 1}
		%W select clear $sel
		set ind [expr $sel+$i]
		%W select set $ind
		%W see $ind
		SF_Select .self $ind [%W get $ind]
	    }
	    Return {.self.b.ok flash; set fsrc 1}
	}
    }
    $w.c config -text "Font count: n/a"
    $w.l.lb insert 0 "Reading fonts, please wait..."
    wm deiconify $w
    tkwait visibility $w.l.lb
    after 100
    update
    if {[catch {set tmp [lsort [exec xlsfonts]]} err]} {
	MessageBox "This dialog requires external 'xlsfonts'-utility!\n\nError: $err !"
	destroy $w
	return $font
    }
    set pr ""
    set fonts {}
    foreach f $tmp {
	if {[string compare $pr $f] == 0} {continue}
	set pr $f
	lappend fonts $f
    }
    $w.l.lb delete 0
    eval "$w.l.lb insert end $fonts"
    $w.c config -text "Font count: [$w.l.lb size]"
    if {[string compare {} $font] == 0} {
	$w.t config -state disabled
	SF_Select $w 0 [$w.l.lb get 0]
	$w.l.lb select set 0
	$w.l.lb activate 0
    } {
	set ind [lsearch -glob $fonts *$font*]
	$w.l.lb select set $ind
	$w.l.lb activate $ind
	$w.l.lb see $ind
	$w.t config -state disabled -font [$w.l.lb get $ind]
	$w.n config -text [$w.l.lb get $ind]
    }
    focus $w.b.ok
    KeepInScreen $w
    grab $w
    tkwait variable fsrc
    grab release $w
    if {$fsrc} {
	set rc [$w.l.lb get [$w.l.lb curselection]]
    } {set rc $font}
    unset fsrc
    destroy $w
    return $rc
}
proc SF_Select {w ind font {iter 0}} {
    if {[catch {$w.t tag configure TEXT -font $font}]} {
	if {$iter == 0} {
	    MessageBox "Non-existing font, updating view..."
	}
	$w.l.lb delete $ind
	$w.l.lb select set $ind
	$w.l.lb activate $ind
	$w.c config -text "Font count: [$w.l.lb size]"
	SF_Select $w $ind [$w.l.lb get $ind] 1
    } {
	$w.n config -text $font
    }
}

proc FS { num defdir mode {file ""} {do_backup 0}} {
    global filesel xf xf_image
    set filesel(result) {}
    set filesel(dir) $defdir
    set filesel(mode) $mode
    set filesel(file) $file
    set filesel(do_backup) $do_backup
    
    switch $mode {
	load {set filesel(modtxt) "Load File"
	set filesel(mc) "#c0c0e0"
	set lab "File: "}
	save {set filesel(modtxt) "Save File"
	set filesel(mc) "#e0c0c0"
	set lab "File: "}
	dir  {set filesel(modtxt) " Get Dir "
	set filesel(mc) "#d0d0a0"
	set lab " Dir: "}
    }
    set fs [toplevel .fs -borderwidth 5]
    wm geometry $fs +300+200
    wm title $fs "FileSelector#$num"

    frame $fs.buttons -relief groove -bd 2
    frame $fs.top
    frame $fs.lbframe
    label $fs.label -text $filesel(modtxt) -relief sunken -bd 0 -bg $filesel(mc)
    pack $fs.label -fill x
    frame $fs.top.pf
    label $fs.top.pf.lab -text "Path: "
    label $fs.top.pf.pathlabel -textvariable filesel(dir)
    frame $fs.top.ef
    label $fs.top.ef.lab -text $lab
    entry $fs.top.ef.entry -textvariable filesel(file)
    pack $fs.top.ef.lab -side left -fill x
    pack $fs.top.ef.entry -side left -fill x -expand true
    $fs.top.ef.entry xview moveto 1
    $fs.top.ef.entry icursor end
    frame $fs.buttons.ok -relief sunken -bd 1
    button $fs.buttons.ok.b -text OK!  -command {FS_ok b 1}
    pack $fs.buttons.ok.b -padx 0 -pady 1
    button $fs.buttons.cancel -text Cancel -command {set filesel(result) {}}
    pack $fs.buttons.cancel -side right -pady 5 -padx 5
    pack $fs.buttons.ok -side left -pady 5 -padx 5
    pack $fs.buttons -side bottom -fill x
    pack $fs.top.pf.lab -side left -fill x
    pack $fs.top.pf.pathlabel -side left -fill x
    pack $fs.top.pf -fill x
    pack $fs.top.ef -fill x
    pack $fs.top -fill x
    frame $fs.lbframe.sb
    listbox $fs.lbframe.lb -yscrollcommand [list $fs.lbframe.sb.sy set]\
	    -width 30 -height 7 -selectmode browse -selectbackground #dfdfaf\
	    -selectborderwidth 2 -selectforeground #101000 -bg #cccccc \
	    -setgrid true -exportselection false
    scrollbar $fs.lbframe.sb.sy -orient vertical\
	    -command [list $fs.lbframe.lb yview]
    button $fs.lbframe.sb.t -image $xf_image(topimage) -padx 0 -pady 0\
	    -command {.fs.lbframe.lb yview 0} -bd 1
    button $fs.lbframe.sb.b -image $xf_image(bottomimage) -padx 0 -pady 0\
	    -command {.fs.lbframe.lb yview end} -bd 1
    pack $fs.lbframe.sb.t -side top -fill x
    pack $fs.lbframe.sb.sy -side top -fill y -expand true
    pack $fs.lbframe.sb.b -side top -fill x
    pack $fs.lbframe.sb -side right -fill y
    pack $fs.lbframe.lb -side left -expand true -fill both
    pack $fs.lbframe -side top -expand true -fill both
    bind .fs.buttons.ok.b <Return> {.fs.buttons.ok.b invoke}
    bind .fs.buttons.cancel <Return> {.fs.buttons.cancel invoke}
    bind .fs.buttons.ok.b <Key> {focus .fs.top.ef.entry}

    bind .fs.top.ef.entry <Return> {catch {FS_ok b}}
    bind .fs.lbframe.lb <Return> {catch {FS_ok b}}

    bind .fs.lbframe.lb <Key-Down> {
	tkListboxUpDown %W 1
	catch {FS_Sel b}
	break
    }
    bind .fs.lbframe.lb <Key-Up> {
	tkListboxUpDown %W -1
	catch {FS_Sel b}
	break
    }
    bind .fs <Escape> {focus .fs.top.ef.entry}
    bind .fs.lbframe.lb <Button-1> {
	tkListboxBeginSelect %W [%W index @%x,%y]
	FS_Sel %y
	break
    }
    bind .fs.lbframe.lb <ButtonRelease-1> {break}
    bind .fs.lbframe.lb <B1-Motion> {
	tkListboxBeginSelect %W [%W index @%x,%y]
	FS_Sel %y
	break
    }
    bind .fs.lbframe.lb  <Double-Button-1> { FS_ok %y ; break}
    bind .fs.lbframe.lb <Button-2> {
	set filesel(b2r) 1
	tkCancelRepeat
	%W scan mark %x %y
	set tkPriv(x) %x
	set tkPriv(y) %y
	set tkPriv(mouseMoved) 0
	%W activate @%x,%y
	after 300 [list set filesel(b2r) 0]
	break
    }
    bind .fs.lbframe.lb <ButtonRelease-2> {
	if {$filesel(b2r)} {
	    tkListboxBeginSelect %W [%W index @%x,%y]
	    update idletasks
	    FS_Sel %y
	    FS_ok %y
	}
	break
    }
    bind .fs.lbframe.lb <B2-Motion> {
	set filesel(b2r) 0
	if {(%x != $tkPriv(x)) || (%y != $tkPriv(y))} {
	    set tkPriv(mouseMoved) 1
	}
	if $tkPriv(mouseMoved) {
	    %W scan dragto 10000 %y
	}
	break
    }
    bind .fs.lbframe.lb <Button-3> {break}
    bind .fs <Prior> {focus .fs.lbframe.lb }
    bind .fs <Next> {focus .fs.lbframe.lb }
    bind .fs <Up> {focus .fs.lbframe.lb }
    bind .fs <Down> {focus .fs.lbframe.lb }
    bind .fs <Home> {focus .fs.lbframe.lb }
    bind .fs <End> {focus .fs.lbframe.lb }
    bind .fs <Control-c> {set filesel(result) {}}
    bind .fs <Escape> {set filesel(result) {}}

    proc FS_List { dir } {
	global filesel env
	if {![file exists $dir]} {
	    set dir $env(HOME)
	}
	set files [glob -nocomplain -- $dir/{.*,*}]
	.fs.lbframe.lb delete 0 end
	set dirs {}
	set others {}
	foreach f [lsort $files] {
	    if {[file isdirectory $f]} {
		if {[file tail $f] != "."} {
		    if {$dir != "/"} {
			lappend dirs [file tail $f]/
		    } {
			if {[file tail $f] != ".."} {
			    lappend dirs [file tail $f]/
			}
		    }
		}
	    } {
		if {[string compare $filesel(mode) "dir"]} {
		    lappend others [file tail $f]
		} {
		    set filesel(file) $dir
		    .fs.top.ef.entry icursor end
		    set others ""
		}
	    }
	}
	set all [concat $dirs $others]
	foreach f $all {
	    .fs.lbframe.lb insert end $f
	}
	cd $dir
	set filesel(dir) $dir
    }

    proc FS_Sel {{y ""}} {
	global filesel
	set t .fs.lbframe.lb
	update idletasks
	if {[string compare $y ""] && [string compare $y "b"]} {
	    set sel [$t get [$t nearest $y]]
	} {
	    if {[catch {set sel [$t get [$t curselection]]}]} {
		set sel [$t get [$t nearest 0]]
	    }
	}
	if {![string compare $y b]} {
	    if {[string compare $filesel(mode) dir]} {
		set filesel(file) $sel
	    } {
		if {[string compare $sel "../"]} {
		    set filesel(file) "$filesel(dir)$sel"
		} {
		    set filesel(file) [GetParentDir $filesel(dir)]
		}
	    }
	    .fs.top.ef.entry icursor end
	    return
	}
	if {[file isdirectory $sel] && $filesel(mode) == "dir"} {
	    if {[string compare $sel "../"]} {
		set filesel(file) "$filesel(dir)$sel"
	    } {
		set filesel(file) $filesel(dir)
	    }
	    .fs.top.ef.entry icursor end
	    return
	}
	if {[string compare [string index $sel [expr {[string length $sel] -1}]] "/"]} {
	    set filesel(file) $sel
	    .fs.top.ef.entry icursor end
	}
    }

    proc FS_ok {{y ""} {ok 0}} {
	global filesel
	set t .fs.lbframe.lb
	if {[file isdirectory "$filesel(dir)$filesel(file)"]} {
	    if {![string compare $filesel(file) "../"]} {
		set filesel(dir) [GetParentDir $filesel(dir)]
	    } {
		set filesel(dir) "$filesel(dir)$filesel(file)"
	    }
	    set filesel(file) ""
	}
	if {[string compare $y "b"]} {
	    if {[string compare $y ""]} {
		set sel [$t get [$t nearest $y]]
	    } {
		set sel [$t get [$t curselection]]
	    }
	    set tmp $filesel(dir)$sel
	} {
	    set sel $filesel(file)
	    if {![string compare $filesel(mode) "dir"]} {
		if {![string compare $sel $filesel(dir)]} {
		    focus .fs.buttons.ok.b
		}
		set tmp $filesel(file)
	    } {
		set tmp $filesel(dir)$sel
	    }
	}
	if {[file isdirectory $tmp]} {
	    if {![string compare $sel "../"]} {
		set filesel(dir) [GetParentDir $filesel(dir)]
	    } {
		set filesel(dir) "$tmp"
	    }
	    if {![file exists $filesel(dir)]} {
		set temp $filesel(dir)
		set filesel(dir) "Dir not found!"
		after 1500 [list set filesel(dir) $temp]
		return 0
	    }
	    if {![string compare $y "b"] && ![string compare $filesel(mode) "dir"] \
		    && $ok} {
		set filesel(result) $filesel(dir)
	    }

	    FS_List $filesel(dir)

	    if {![string compare $filesel(mode) "dir"]} {
		set filesel(file) $filesel(dir)
	    }
	} {
	    if {[file exists $tmp]} {
		if {![string compare $filesel(mode) "save"]} {
		    if {[AskWin "File exists!\nOverwrite ?!"]} {
			# Check, if backup requested"
			if {$filesel(do_backup)} {
			    catch {file copy -force -- $tmp $tmp~}
			}
			set filesel(result) $tmp
		    } {
			return 0
		    }
		}
		set filesel(result) $tmp
	    } {
		if {![string compare $filesel(mode) "save"]} {
		    set filesel(result) $tmp
		}
		set temp $filesel(dir)
		set filesel(dir) "File not found!"
		after 1500 [list set filesel(dir) $temp]
		return 0
	    }

	}
    }

    FS_List $filesel(dir)
    focus .fs.top.ef.entry
    tkwait variable filesel(result)
    destroy .fs
    return $filesel(result)
}

proc SelectColor {color {xoffset -75} {yoffset -100} {X {}} {Y {}}} {
    global ce

    catch {destroy .ce}
    set cep [toplevel .ce]
    if {[option get .xfiles messages_always_on_top {}] == 1} {
	bind $cep <Visibility> [list KeepOnTop $cep %W %s]
    }
    if {[string compare {} $X] == 0} {
	set x [expr {[winfo pointerx .] + $xoffset}]
	set y [expr {[winfo pointery .] + $yoffset}]
    } {
	set x [expr {$X + $xoffset}]
	set y [expr {$Y + $yoffset}]
    }
    wm geometry $cep "+$x+$y"
    wm title $cep "Select Color v0.2"
    wm resizable $cep 0 0
    if {[catch {set ce(red) [format "%d" 0x[string range $color 1 2]]} err]} {
	tkerror $err
	set ce(red) 0
    }
    if {[catch {set ce(green) [format "%d" 0x[string range $color 3 4]]} err]} {
	tkerror $err
	set ce(green) 0
    }
    if {[catch {set ce(blue) [format "%d" 0x[string range $color 5 6]]} err]} {
	tkerror $err
	set ce(blue) 0
    }
    frame $cep.s -relief sunken -bd 1 -width 80 -height 45
    scale $cep.s.red -orient vertical -from 255 -to 0\
	    -resolution 1 -length 4c -fg "#af3030" -variable ce(red)\
	    -command {CE_ChColor ; set ce(red)}
    scale $cep.s.green -orient vertical -from 255 -to 0\
	    -resolution 1 -length 4c -fg "#30af30" -variable ce(green)\
	    -command {CE_ChColor ; set ce(green)}
    scale $cep.s.blue -orient vertical -from 255 -to 0\
	    -resolution 1 -length 4c -fg "#3030af" -variable ce(blue)\
	    -command {CE_ChColor ; set ce(blue)}
    frame $cep.c -relief sunken -bd 2 -height 30
    frame $cep.b
    button $cep.b.apply -text "Select" -command {set ce(ret) 1}
    button $cep.b.cancel -text "Cancel" -command {set ce(ret) 0}
    pack $cep.s.red $cep.s.green $cep.s.blue -side left
    pack $cep.s
    pack $cep.c -side top -fill both
    pack $cep.b.apply -side left -padx 3 -pady 3
    pack $cep.b.cancel -side right -padx 3 -pady 3
    pack $cep.b -side bottom -fill x -expand 1
    bind $cep <Control-c> {set ce(ret) 0}
    bind $cep <Escape> {set ce(ret) 0}
    bind $cep <Return> {set ce(ret) 1}
    grab $cep
    focus $cep.b.apply
    tkwait visibility $cep
    KeepInScreen $cep
    tkwait variable ce(ret)
    grab release $cep
    if {$ce(ret)} {
	set rc $ce(color)
    } {
	set rc $color
    }
    unset ce
    destroy $cep
    return $rc
}

proc CE_ChColor {} {
    global ce
    set ce(color) [format "#%02x%02x%02x" $ce(red) $ce(green) $ce(blue)]
    .ce.c config -bg $ce(color)
}

proc Externals {} {
    global tcl_version
    set txt "External commands used:\n"
    foreach p [list cp mv rm mkdir uname df du chmod zip unzip tar lha xlsfonts mail] {
	set st "Not found!"
	if {$tcl_version < 7.6} {
	    if {[auto_execok $p]} {
		set st "Found."
	    }
	} elseif {[string compare [auto_execok $p] {}]} {
	    set st "Found."
	}
	switch -glob -- $p {
	    cp -
	    mv -
	    rm -
	    mkdir {
		if {[string match "Found." $st]} {set fops "Available."} {set fops "Not available!"}
	    }
	    du {
		if {[string match "Found." $st]} {set du "Available."} {set du "Not available!"}
	    }
	    chmod {
		if {[string match "Found." $st]} {set chmod "Available."} {set chmod "Not available!"}
	    }
	    df {
		if {[string match "Found." $st]} {set df "Available."} {set df "Not available!"}
	    }
	    *zip {
		if {[string match "Found." $st]} {set zip "Available."} {set zip "Not available!"}
	    }
	    tar {
		if {[string match "Found." $st]} {set tar "Available."} {set tar "Not available!"}
	    }
	    lha {
		if {[string match "Found." $st]} {set lha "Available."} {set lha "Not available!"}
	    }
	    xlsfonts {
		if {[string match "Found." $st]} {set xlsfonts "Available."} {set xlsfonts "Not available!"}
	    }
	}
	switch $p {
	    "mkdir" {
		append txt [format "\n%-8s: %-20s %-21s: %s\n" $p $st "Basic fileoperations" $fops]
		append txt " -------------------------------------------------------------\n"
	    }
	    "df" {
		append txt [format "\n%-8s: %-20s %-21s: %s\n" $p $st "Diskfree information" $df]
		append txt " -------------------------------------------------------------\n"
	    }
	    "du" {
		append txt [format "\n%-8s: %-20s %-21s: %s\n" $p $st "DirSize function" $du]
		append txt " -------------------------------------------------------------\n"
	    }
	    "chmod" {
		append txt [format "\n%-8s: %-20s %-21s: %s\n" $p $st "ProtEditor dialog" $chmod]
		append txt " -------------------------------------------------------------\n"
	    }
	    "unzip" {
		append txt [format "\n%-8s: %-20s %-21s: %s\n" $p $st "VirtualZip-mode" $zip]
		append txt " -------------------------------------------------------------\n"
	    }
	    "tar" {
		append txt [format "\n%-8s: %-20s %-21s: %s\n" $p $st "VirtualTar-mode" $tar]
		append txt " -------------------------------------------------------------\n"
	    }
	    "lha" {
		append txt [format "\n%-8s: %-20s %-21s: %s\n" $p $st "VirtualLha-mode" $lha]
		append txt " -------------------------------------------------------------\n"
	    }
	    "xlsfonts" {
		append txt [format "\n%-8s: %-20s %-21s: %s\n" $p $st "Select Fonts -dialog" $lha]
		append txt " -------------------------------------------------------------\n"
	    }
	    default {
		append txt [format "\n%-8s: %s" $p $st]
	    }
	}
    }
    MessageBox $txt {} -50 -50 {} {} 550 fixed
}

# This procedure creates the Column Setup dialog, where one
# can set the visibility, order, justification and in some 
# cases the width of a column that is shown in the listings.
proc XF_ColumnSetup {{xoffset -100} {yoffset -100} {X {}} {Y {}}} {
    global cs xf

    catch {destroy .cs}
    set cs(dlg) [toplevel .cs]
    
    wm withdraw $cs(dlg)

    # Cannot do this until solved the competing dialogs -problem
    #if {[option get .xfiles messages_always_on_top {}] == 1} {
	#bind $cs(dlg) <Visibility> [list KeepOnTop $cs(dlg) %W %s]
    #}
    if {[string compare {} $X] == 0} {
	set x [expr {[winfo pointerx .] + $xoffset}]
	set y [expr {[winfo pointery .] + $yoffset}]
    } {
	set x [expr {$X + $xoffset}]
	set y [expr {$Y + $yoffset}]
    }
    wm geometry $cs(dlg) "+$x+$y"
    wm title $cs(dlg) "X-Files Column Setup v0.2"
    wm resizable $cs(dlg) 0 0
    
    # outer frame
    frame $cs(dlg).f
    grid $cs(dlg).f -sticky news -ipadx 5 -ipady 5
    set w $cs(dlg).f
    
    # headers
    label $w.ln -text Column
    set font [$w.ln config -font]
    $w.ln config -font [lindex $font 3]
    label $w.lj -text Justify -font [lindex $font 3]
    label $w.lw -text Width -font [lindex $font 3]

    grid $w.ln 
    grid $w.lj -row 0 -column 1 -columnspan 2 
    grid $w.lw -row 0 -column 3

    # column buttons
    button $w.bname -text Name -width 8 -command [list CS_SetSample $w.bname]
    button $w.bsize -text Size -width 8 -command [list CS_SetSample $w.bsize]
    button $w.bprot -text Protection -width 8 -command [list CS_SetSample $w.bprot]
    button $w.bmtim -text MTime -width 8 -command [list CS_SetSample $w.bmtim]
    button $w.bowne -text Owner -width 8 -command [list CS_SetSample $w.bowne]
    button $w.bgrou -text Group -width 8 -command [list CS_SetSample $w.bgrou]

    # justification buttons
    radiobutton $w.jnl -text Left -variable cs(j.name) -value 1
    radiobutton $w.jnr -text Right -variable cs(j.name) -value 0
    radiobutton $w.jsl -text Left -variable cs(j.size) -value 1
    radiobutton $w.jsr -text Right -variable cs(j.size) -value 0
    radiobutton $w.jpl -text Left -variable cs(j.prot) -value 1
    radiobutton $w.jpr -text Right -variable cs(j.prot) -value 0
    radiobutton $w.jtl -text Left -variable cs(j.mtim) -value 1
    radiobutton $w.jtr -text Right -variable cs(j.mtim) -value 0
    radiobutton $w.jol -text Left -variable cs(j.owne) -value 1
    radiobutton $w.jor -text Right -variable cs(j.owne) -value 0
    radiobutton $w.jgl -text Left -variable cs(j.grou) -value 1
    radiobutton $w.jgr -text Right -variable cs(j.grou) -value 0

    # width entries, some are read-only and flat
    entry $w.en -textvariable cs(w.name) -width 3
    entry $w.es -textvariable cs(w.size) -width 3
    entry $w.ep -textvariable cs(w.prot) -relief groove -state disabled -width 3
    entry $w.et -textvariable cs(w.mtim) -relief groove -state disabled -width 3
    entry $w.eo -textvariable cs(w.owne) -width 3
    entry $w.eg -textvariable cs(w.grou) -width 3

    grid $w.bname $w.jnl $w.jnr $w.en
    grid $w.bsize $w.jsl $w.jsr $w.es
    grid $w.bprot $w.jpl $w.jpr $w.ep
    grid $w.bmtim $w.jtl $w.jtr $w.et
    grid $w.bowne $w.jol $w.jor $w.eo
    grid $w.bgrou $w.jgl $w.jgr $w.eg

    # sample label header
    label $w.lsh -text "Sample column order:"
    grid $w.lsh -sticky w
    # sample label
    label $w.ls -textvariable cs(sample) -relief groove \
	    -justify left -anchor w -bg #c7c7c7
    grid $w.ls -columnspan 4 -sticky news

    # empty row
    label $w.dummy -height 3
    grid $w.dummy

    # command buttons
    button $w.ok -text OK -width 6 -command {CS_CheckEntries 1}
    button $w.cancel -text Cancel -width 6 -command {CS_CheckEntries 0}
    grid $w.ok -row 9 -column 0 -sticky ws
    grid $w.cancel -row 9 -column 3 -sticky es

    # initialize justification, width variables and selected columns
    foreach nn [list name size prot mtim owne grou] {
	set cs(w.$nn) [lindex $xf(cf.$nn) 1]
	set cs(j.$nn) [lindex $xf(cf.$nn) 2]
    }
    for {set i 1} {$i < 7} {incr i} {
	foreach nn [list name size prot mtim owne grou] {
	    # column should be visible in this position
	    if {[lindex $xf(cf.$nn) 0] == $i} {
		$cs(dlg).f.b$nn invoke
		break
	    }
	}
    }

    # rest of dialog init
    bind $cs(dlg) <Control-c> {set cs(rc) 0}
    bind $cs(dlg) <Escape> {set cs(rc) 0}
    wm deiconify $cs(dlg)
    tkwait visibility $cs(dlg)
    KeepInScreen $cs(dlg)

    grab $cs(dlg)
    tkwait variable cs(rc)
    grab release $cs(dlg)

    set rc $cs(rc)
    if {$rc == 1} {
	# save justification and width variables
	set tmp [string tolower $cs(sample)]
	foreach nn [list name size prot mtim owne grou] {
	    set ind [lsearch -glob $tmp ${nn}*]
	    incr ind
	    set xf(cf.$nn) "$ind $cs(w.$nn) $cs(j.$nn)"
	}
	MakeColumnFormat left
	ColumnHeaders left
	MakeColumnFormat right
	ColumnHeaders right
	#SaveColumnFormat
	SetWaitPointer
	UpdBoth
	SetArrowPointer
    }

    destroy $cs(dlg)
    unset cs
    return $rc
}
# This procedure sets the sample row depending on the state of the
# button pressed.
# Param: path of button pressed
proc CS_SetSample {b} {
    global cs

    if {[string match {raised} [lindex [$b config -relief] end]]} {
	$b config -relief sunken
	append cs(sample) "[lindex [$b config -text] end] "
    } {
	$b config -relief raised
	regsub "[lindex [$b config -text] end] " $cs(sample) {} cs(sample)
    }
}
# This procedure checks the entry fields for illegal characters
# and ends the window loop, if necessary.
# Param: OK -> 1, Cancel -> 0
proc CS_CheckEntries {rc} {
    global cs
    
    # if OK and there are no columns selected...
    if {[string compare $cs(sample) {}] == 0 && $rc} { 
	if {[AskWin "You have specified no columns! Are you sure about this?"] == 0} {
	    return
	}
    }
    if {$rc == 1} {
	set err 0
	set msg "You have illegal characters in entries:\n"
	foreach type [list name size prot mtim owne grou] {
	    set str [lindex [$cs(dlg).f.b$type config -text] end]
	    # check all, because values are saved to file
	    # check for illegal characters
	    if {[regexp {[^0-9]} $cs(w.$type)]} {
		set err 1
		append msg "--> [lindex [$cs(dlg).f.b$type config -text] end]\n"
	    }
	}
	if {$err == 1} {
	    append msg "\nThe value must be a number!"
	    MessageBox $msg
	} {
	    set cs(rc) 1
	}
    } {
	set cs(rc) 0
    }
}


# Follows the given variable and changes the status of active indicator
proc XF_BgActive {var index op} {
    upvar #0 $var arr
    global xf

    if {[string match {*Busy*} $arr($index)]} {
	#puts XF_BG-blink
	# clear old blinks
	foreach ps [after info] {
	    if {[string match *XF_Blink* [after info $ps]]} {
		after cancel $ps
	    }
	}
	set xf(bgact.on) 1
	XF_Blink 1
    } {
	set xf(bgact.on) 0
    }
}

# Blinks the fs-field in InfoArea when bg is active
proc XF_Blink {on} {
    global xf
    
    if {$xf(bgact.on)} {
	if {$on} {
	    $xf(fsE_$xf(bgact.side)) config -bg "#6c6c6c" -fg "#ffff60"
	} {
	    $xf(fsE_$xf(bgact.side)) config -bg "#404040" -fg "#ffff60"
	}
	update idletasks
	after 1000 [list XF_Blink [expr {!$on}]]
    } {
	# restore default colors
	$xf(fsE_$xf(bgact.side)) config -bg "#404040" -fg "#ffff60"
    }
}

# args: socket -- socket id
#       first  -- boolean whether this is construction call and the window
#                 can be withdrawn initially
proc XF_ProgressBar {socket {first 1}} {
    global pb ftp xf

    if {[winfo exists .__pbar]} {
	wm deiconify .__pbar
	raise .__pbar
	return
    }
    set pb(first) $first
    set pb(final) 0
    set pb(sock) $socket
    set pb(pros) 0
    set pb(text) [format "%5s  %5s  %7.2f %s" 00:00 00:00 0.00 "kb/s"]
    set pb(info) ""
    #catch {destroy .__pbar}
    set w [toplevel .__pbar -bd 3 -relief groove]
    if {$first} {
	wm withdraw .__pbar
    }
    wm title $w "XF Progress"
    label $w.op -textvariable pb(info)
    set pb(canvas) [canvas $w.c -width 100 -height 20 -relief sunken -bd 2]
    label $w.time -textvariable pb(text)
    set pb(abort) [button $w.b -text Abort! -command [list XF_PBAbort $socket]]
    grid $w.op -sticky ew
    grid $w.c -sticky ew
    grid $w.time -sticky ew
    grid $w.b -ipady 0
 
    $w.c create rect 0 0 [expr {1 + $pb(pros)}] 25 -fill "#ff8888" -width 0 -tag slider
    $w.c create text 80 15 -text "0% of 0 kb" -tag val 
    set xf(ftp.aborted) 0
}

# params:  item      - file name
#          op        - operation (putting/getting)
proc XF_PBItem {item op} {
    global ftp pb

    if {$ftp($pb(sock).totalsize) == 0} {
	# file has no size, abort
	return
    }
    # clear old incrs
    foreach ps [after info] {
	if {[string match *XF_PBIncr* [after info $ps]]} {
	    after cancel $ps
	}
    }
    if {[winfo exists .__pbar] == 0} {
	XF_ProgressBar $pb(sock) 0
    }
    if {$pb(first) == 1} {
	# initial, window is withdrawn
	wm deiconify .__pbar
	set pb(first) 0
    }

    set pb(info) "$op: '$item'..."
    $pb(canvas) itemconfigure val -text [list $pb(pros)% of [expr {$ftp($pb(sock).totalsize)/1024}] kb]
    update idletasks
    after 500 XF_PBIncr
    #parray pb
}

proc XF_PBAbort {socket} {
    global pb xf ftp

    # MKi 26.3.98 let's leave this out, at least for now
    #switch [AskWin "Abort only this or the whole transfer?" -50 -50 All {} {} This Cancel] {
	#0 {
	    # cancel
	    #return
	#}
	#2 {
	    # all
	    #set xf(ftp.aborted) 1
	#}
    #}

    set xf(ftp.aborted) 1
    #$pb(abort) config -state disabled
    #SetWaitPointer .__pbar
    #puts "Abort(): a"
    XF_PBFinal
    #puts "Abort(): a.2"
    if {[FTP_ABORT $socket] == -1} {
    #puts "Abort(): b.1"
	# GET operation, kill sockets and reconnect
	catch {close $ftp($socket.datasock)}
	catch {close $socket}

    #puts "Abort(): b.2"
	after idle [list FO_FTPReconnect $xf(bgact.side)]
    #puts "Abort(): b.3"
    }
    #puts "Abort(): end"
}

# Shows the final status of the transfer
proc XF_PBFinal {} {
    global pb ftp
    
    #puts "XF_PBFinal"
    if {[winfo exists .__pbar]} {
	set pb(final) 1
	set pb(pros) 100
	$pb(canvas) coords slider 0 0 [winfo width $pb(canvas)] 25
	$pb(canvas) itemconfigure val -text [list $pb(pros) % of [expr {$ftp($pb(sock).totalsize)/1024}] kb]
	# update time and rate
	set elapsed [clock format [expr {int(ceil($ftp($pb(sock).totaltime)))}] -format "%M.%S"]
	set pb(text) [format "%5s  %5s  %7.2f %s" $elapsed 00:00 [expr {$ftp($pb(sock).transrate)/1024}] "kb/s"]
	update idletasks
	
	XF_PBDestroy
    }
}

proc XF_PBDestroy {} {
    global pb
    catch {destroy .__pbar}
}

# Periodically updates the view
proc XF_PBIncr {} {
    global pb ftp
    
    # check that pbar exists
    if {[winfo exists .__pbar] && $pb(final) == 0} {
	# update slider
	set pb(pros) [expr {($ftp($pb(sock).currsize) * 100) / $ftp($pb(sock).totalsize)}]
	wm title .__pbar "XF Progress $pb(pros)%"

	$pb(canvas) coords slider 0 0 [expr {(1 + $pb(pros)) * [winfo width $pb(canvas)] / 100}] 25
	$pb(canvas) itemconfigure val -text [list $pb(pros)% of [expr {$ftp($pb(sock).totalsize)/1024}] kb]
	# update time and rate
	set elapsed [expr {[clock seconds] - $ftp($pb(sock).starttime)}]
	if {$elapsed == 0} {set elapsed 1}
	set rate [expr $ftp($pb(sock).currsize).0 / $elapsed]
	if {$rate == 0} {set rate 1}
	set elapsed [clock format $elapsed -format "%M:%S"]
	set expect [clock format [expr {int(($ftp($pb(sock).totalsize)-$ftp($pb(sock).currsize)) / $rate)}] -format "%M:%S"]
	set pb(text) [format "%5s  %5s  %7.2f %s" $elapsed $expect [expr {$rate/1024}] "kb/s"]

	update idletasks
	after 500 XF_PBIncr

    }
}

# Pseudo-encrypt
#   
proc Encrypt {string {key 52}} {
    set res_list ""
    expr {srand($key)}
    for {set i 0} {$i < [string length $string] } {incr i} {
	scan [string index $string $i] "%c" result
	#puts $result
	lappend res_list [expr {int(128 * rand()) + $result}]
    }
    return $res_list
}

#################
# Pseudo-decrypt
#
proc Decrypt {string {key 52}} {
    set res_string ""
    expr {srand($key)}
    for {set i 0} {$i < [llength $string] } {incr i} {
	append res_string [format "%c"\
		[expr {[lindex $string $i] - int(128 * rand())}]]
    }
    return $res_string
}
