#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/dialog.tcl,v $
# $Date: 1997/03/03 09:59:07 $
# $Revision: 1.18.1.23 $
#
package provide zircon 1.18
#
proc doButtons {w param lv pars} {
    if {[llength $pars] > 0} {
	set arg [lindex $pars 0]
	frame $w.bot.0 -borderwidth 1 -relief raised
	pack $w.bot.0 -side left -expand 1 -fill x -padx 5 -padx 5
	switch {} [set cmd [lindex $arg 1]] {} default {append cmd " $param"}
	switch {} $lv {} default {
	   bind $lv <Return> "$cmd ; killWindow $w ; notIdle {} ; break"
	   bind $lv <Tab> "focus $w.top.v0.value ; notIdle {} ; break"
	}
	button $w.bot.0.button -text [lindex $arg 0] -width 7 \
		-command "$cmd ; killWindow $w ; notIdle {}"
	pack $w.bot.0.button -expand 1 -fill x -padx 5 -pady 5
	bind $w <Return> "$cmd ; killWindow %W ; notIdle {} ; break"
	set i 1
	foreach arg [lrange $pars 1 end] {
	    switch {} [set cmd [lindex $arg 1]] {} default {append cmd " $param"}
	    button $w.bot.$i -text [lindex $arg 0] -width 7 \
	      -command "$cmd ; killWindow $w ; notIdle {}"
	    pack $w.bot.$i -side left -expand 1 -fill x -padx 5 -pady 5
	    incr i
	}
    }
    switch {} $lv {set sf $w} default {set sf $w.top.v0.value}
    bind $w <Any-Enter> "focus $sf ; notIdle {} ; break"
    focus $sf
}
#
proc doEntries {w entries arg} {
    set param {}
    set vb 0
    set lv {}
    foreach entry $entries {
	set f [frame $w.top.v$vb]
	set lv $f.value
	set lb $f.label
	switch {} [lindex $entry 2] {
	    label $lb -text [lindex $entry 0]
	} default {
	    menubutton $lb -text [lindex $entry 0] -menu $lb.menu
	    menu $lb.menu -tearoff 0
	    foreach x [lindex $entry 2] {
		$lb.menu add command -label $x -command "entrySet $lv $x"
	    }
	}
	emacsEntry $lv
	switch {} [set init [lindex $entry 1]] {} default {
	    $lv insert end $init
	}
	switch palette [lindex $entry 3] {
	    bind $lv <Escape> "makePalette ${w}PL {} $lv {} {} {}"
	    bind $lv <ButtonPress-3> "popPalette ${w}PP {} $lv {} %X %Y"
	}
	append param " \[$lv get\]"
	pack $lb -side left -padx 5 -pady 5
	pack $lv -side left -expand 1 -fill x -padx 10 -pady 10
	pack $f -fill x -padx 5 -pady 5
	incr vb
	bind $lv <Return> "notIdle {} ; focus $w.top.v$vb.value ; break "
	bind $lv <Tab> "notIdle {} ; focus $w.top.v$vb.value ; break"
    }
    doButtons $w $param $lv $arg
}
#
proc mkDialog {kind w title msgText entries args} {
    switch {} $args {
	global ztrans
	set args [list [list $ztrans(dismiss) {}]]
    }
    switch {} $kind {} default {
	upvar #0 currentNet net
	if [listmember [$net noConfirm] $kind] {
	    set param {}
	    foreach entry $entries { append param "{[lindex $entry 1]}" }
	    if {[llength $args] > 0 && \
	      [set cmd [lindex [lindex $args 0] 1]] != {}} {
		append cmd " $param"
	    }
	    eval $cmd
	    return {}
	}
	if [listmember [$net toInfo] $kind] {
	    $net inform $msgText
	    return {}
	}
    }
    set just [expr {[listmember \
      {DCC WHO STATS INFO LINKS WHOIS} $kind] ? "left" : "center"}]
    switch {} $w {set w .@[newName dlg]} default {killWindow $w}
    toplevel $w -class Zircon
    wm title $w "$title"
    wm protocol $w WM_DELETE_WINDOW {}
    wm transient $w [winfo toplevel [winfo parent $w]]
    pack [frame $w.top -relief raised] -fill both -expand 1
    pack [frame $w.bot -relief raised] -fill x
    switch left $just {
	scrollbar $w.top.vscroller -command "$w.top.message yview"
	text $w.top.message -yscrollcommand "$w.top.vscroller set"
	bindtags $w.top.message ROText
	$w.top.message insert insert $msgText
	set ln [lindex [split [$w.top.message index end] .] 0]
	$w.top.message conf -height $ln
	pack $w.top.message -side left -expand 1 -fill both
	pack $w.top.vscroller -side left -fill y
    } default {
	message $w.top.message -justify $just -text $msgText -aspect 800
	pack $w.top.message -expand 1 -fill both
    }
    doEntries $w $entries $args
    catch {tkwait visibility $w ; grab $w}
    return $w
}
#
proc mkEntryBox {w title msgText entries args} {
    switch {} $args {
	global ztrans
	set args [list [list $ztrans(dismiss) {}]]
    }
    switch {} $w { set w .@[newName dlg] } default {killWindow $w}
    toplevel $w -class Zircon
    wm title $w $title
    wm protocol $w WM_DELETE_WINDOW {}
    wm transient $w [winfo toplevel [winfo parent $w]]
    pack [frame $w.top -relief raised] -fill both -expand 1
    pack [frame $w.bot -relief raised] -fill x
    pack [message $w.top.message -text $msgText -aspect 800] -expand 1 \
      -fill both
    doEntries $w $entries $args
    return $w
}
#
proc mkRadioBox {w title msgText flags dflag entries args} {
    global RFlags
    killWindow $w
    toplevel $w -class Zircon
    wm title $w "$title"
    wm protocol $w WM_DELETE_WINDOW {}
    wm transient $w [winfo toplevel [winfo parent $w]]
    frame $w.top -relief raised
    frame $w.bot -relief raised
    pack $w.top -fill both -expand 1
    pack $w.bot -fill x
    message $w.top.message -text $msgText -aspect 800
    pack $w.top.message -expand 1 -fill both

    set param {}
    set vb 0
    set lv {}
    foreach entry $entries {
	set f [frame $w.top.v$vb]
	set lv $f.value
	label $f.label -text [lindex $entry 0]
	emacsEntry $lv
	switch {} [set init [lindex $entry 1]] {} default {$lv insert end $init}
	append param " \[$lv get\]"
	pack $f.label -side left -padx 5 -pady 5
	pack $lv -side left -expand 1 -fill x  -padx 10 -pady 10
	pack $f -fill x -padx 5 -pady 5
	incr vb
	bind $lv <Return> "notIdle {} ; focus $w.top.v$vb.value ; break"
	bind $lv <Tab> "notIdle {} ; focus $w.top.v$vb.value ; break"
    }
    set f [frame $w.top.flg]
    foreach entry $flags {
	radiobutton $f.rb$entry -text $entry -value $entry -variable RFlags($w)
	pack $f.rb$entry -side left
    }
    set RFlags($w) $dflag
    pack $w.top.flg -fill x -expand 1 -padx 5 -pady 5
    append param " RFlags $w"
    doButtons $w $param $lv $args
    return $w
}
#
proc mkInfoBox {net kind w title msgText args} {
    switch {} $args {
	global ztrans
	set args [list [list $ztrans(dismiss) {}]]
    }
    switch {} $kind {} default {
	if [listmember [$net noConfirm] $kind] {
	    if {[llength $args] > 0} {eval [lindex [lindex $args 0] 1] }
	    return [[$net info] text]
	}
	if [listmember [$net toInfo] $kind] {
	    $net inform $msgText
	    return [[$net info] text]
	}
    }
    set just [expr {[listmember \
      {DCC WHO STATS INFO LINKS WHOIS} $kind] ? {left} : {center}}]

    switch {} $w {set w .@[newName ifb]} default {killWindow $w}
    toplevel $w -class Zircon -borderwidth 2
    wm title $w $title
    wm protocol $w WM_DELETE_WINDOW {}
    wm transient $w [winfo toplevel [winfo parent $w]]
    frame $w.top -borderwidth 0
    bind $w.top <Destroy> break
    frame $w.bot -borderwidth 0
    switch left $just {
        frame $w.top.hs -borderwidth 0
	frame $w.top.vs -borderwidth 0
	scrollbar $w.top.vs.vscroller -command "$w.top.message yview"
	scrollbar $w.top.hs.hscroller -command "$w.top.message xview" \
	  -orient horizontal
	text $w.top.message -width 80 -height 10 -wrap none \
	  -xscrollcommand "hsSet $w.top" \
	  -yscrollcommand "bsSet $w.top.vs.vscroller"
	bindtags $w.top.message ROText
	switch {} $msgText {} default {
	    $w.top.message insert insert $msgText
	    set ln [lindex [split [$w.top.message index end] .] 0]
	    set ln [expr $ln > 24 ? 24 : $ln]
	    $w.top.message conf -height $ln
	}
	pack $w.top.hs.hscroller -side left -fill x -expand 1
	frame $w.top.hs.pd -borderwidth 0
	pack $w.top.message -side left -expand 1 -fill both -in $w.top.vs
	pack $w.top.vs -fill both -expand 1
    } default {
	message $w.top.message -justify $just -text $msgText -aspect 800
	pack $w.top.message -expand 1 -fill both
    }
    pack $w.bot -fill x -side bottom
    pack $w.top -fill both -expand 1 -side top
    doButtons $w {} {} $args
    return $w.top.message
}
#
proc hsSet {sb f l} {
    if {$f == 0 && $l == 1} {
	catch {pack forget $sb.hs}
    } {
	catch {pack $sb.hs -fill x}
	$sb.hs.hscroller set $f $l
	if ![catch {pack info $sb.vs.vscroller}] {
	    catch {pack $sb.hs.pd -side right -padx 10}
	}
    }
}
#
proc setFile {w y cmd init dirv} {
    set x [$w.mid.flist.l nearest $y]
    set fn [$w.mid.flist.l get $x]
    checkFile $w $fn $cmd $init $dirv
}
#
proc fillFile {w fn} {
    global Shall FBFilter
    $w.mid.flist.l delete 0 end
    set od [pwd]
    cd $fn
    set ptns *
    if $Shall($w) { set ptns {.* *} }
	foreach ptn $ptns {
	if ![catch {set fls [glob -nocomplain $ptn]}] {
	    foreach fl [lsort $fls] {
		switch -exact -- $fl { . - .. { continue} }
		if [file isdirectory $fl] { append fl / } \
		elseif ![regexp -- $FBFilter($w) $fl] { continue }
		$w.mid.flist.l insert end $fl
	    }
	}
    }
    cd $od
}
#
proc checkFile {w fn cmd init dirv} {
    upvar #0 $dirv dir
    if [file isdirectory [set fn [file join $dir $fn]]] {
	set dir $fn
	regexp {^(.+)/$} $dir m dir
	setDirMenu $w $cmd $init $dirv
	entrySet $w.mid.fn.entry $init
	fillFile $w $fn
    } {
	eval $cmd $fn
	killFWindow $w
	notIdle {}
    }
}
#
proc mkFileBox {w dirv filter title msgText init args} {
    upvar #0 $dirv direct
    if {![info exists direct] || [string match {} $direct]} {
	set direct [pwd]
    }
    switch {} $w {set w .@[newName flb]} default {killFWindow $w}
    global FBFilter ztrans
    set FBFilter($w) $filter
    toplevel $w -class Zircon
    wm title $w "$title"
    wm protocol $w WM_DELETE_WINDOW "catch {unset FBFilter($w)}"
    wm resizable $w 1 1
    wm transient $w [winfo toplevel [winfo parent $w]]
    frame $w.top -relief raised
    frame $w.mid -borderwidth 0
    frame $w.bot -relief raised
    pack $w.top $w.mid -fill both -expand 1
    pack $w.bot -fill x -side bottom
    switch {} $msgText {} default {
	message $w.top.message -text $msgText -aspect 800
	pack $w.top.message -expand 1 -fill both
    }
    set arg [lindex $args 0]
    set cmd [lindex $arg 1]
    menubutton $w.mid.dir -relief raised -menu $w.mid.dir.menu -borderwidth 2
    menu $w.mid.dir.menu -tearoff 0
    setDirMenu $w $cmd $init $dirv
    pack $w.mid.dir -fill x -padx 5
    makeLB $w.mid.flist
    pack $w.mid.flist -expand 1 -fill both
    uplevel 0 set Shall($w) 0
    checkbutton $w.mid.shall -text {Show Hidden Files} -variable Shall($w) \
	-command "checkFile $w \[set $dirv\] {$cmd} {$init} $dirv"
    pack $w.mid.shall
    labelEntry 0 $w.mid.filter "-text $ztrans(filter)" {.*} "setFilter %W {$init} $dirv; break"
    labelEntry 0 $w.mid.fn "-text $ztrans(filename)" $init \
      "checkFile $w \[%W get\] {$cmd} {$init} $dirv; killFWindow $w ; break"
    pack $w.mid.filter $w.mid.fn -expand 1 -fill x
    fillFile $w $direct
    bind $w.mid.flist.l <1> "
	set x \[%W nearest %y\]
	set f \[%W get \$x\]
	entrySet $w.mid.fn.entry \
	 \[expr {\[file isdirectory \$f\] ? {} : \$f }\]
	%W selection anchor \$x
	break
    "
    bind $w.mid.flist.l <Double-1> "setFile $w %y {$cmd} {$init} $dirv; break"
    switch {} $args {} default {
	frame $w.bot.0 -relief raised -border 1
	pack $w.bot.0 -side left -expand 1 -fill x -padx 5 -pady 5
	set cmd [lindex $arg 1]
	switch {} $cmd {} default {append cmd " \[file join \[set $dirv\] \[$w.mid.fn.entry get\]\]"}
	button $w.bot.0.button -text [lindex $arg 0] \
		-command "$cmd ; killFWindow $w ; notIdle {}"
	pack $w.bot.0.button -expand 1 -fill x -padx 5 -pady 5
	bind $w <Return> "$cmd ; killFWindow %W ; notIdle {} ; break"
	focus $w
	set i 1
	foreach arg [lrange $args 1 end] {
	    set cmd [lindex $arg 1]
	    switch {} $cmd {} default {append cmd " \[file join \[set $dirv\] \[$w.mid.fn.entry get\]\]"}
	    button $w.bot.$i -text [lindex $arg 0] \
	      -command "$cmd ; killFWindow $w ; notIdle {}"
	    pack $w.bot.$i -side left -expand 1 -fill x
	    incr i
	}
    }
    bind $w <Any-Enter> {focus %W ; notIdle {} ; break}
    return $w
}
#
proc setDirMenu {w cmd init dirv} {
    upvar #0 $dirv dir
    [set mn $w.mid.dir.menu] delete 0 end
    $mn add command -label / -command "checkFile $w / {$cmd} {$init} $dirv"
    set crt {}
    set lst [split $dir /]
    foreach x [lrange $lst 1 end] {
	switch {} $x continue
	append crt /$x
	$mn add command -label $x \
	  -command "checkFile $w {$crt} {$cmd} {$init} $dirv"
    }
    
    switch / $dir {
	$w.mid.dir configure -text /
    } default {
	$w.mid.dir configure -text [lindex $lst end]
    }
}
#
proc setFilter {win init dirv} {
   global FBFilter
   set w [winfo toplevel $win]
   set FBFilter($w) [$win get]
   checkFile $w {} {} $init $dirv
}
#
proc killFWindow {w} {
    catch {uplevel #0 FBFilter($w) Shall($w)}
    killWindow $w
}
#
#
proc warnUser {t m} {
    switch [tk_dialog .@[newName wu] $t $m warning 0 ok cancel] 0 {return 1} 1 {return 0}
}
#
proc askUser {kind t m} {
    switch {} $kind {} default {
	global currentNet
	if [listmember [$currentNet noConfirm] $kind] { return 1 }
    }
    switch [tk_dialog .@[newName au] $t $m question 0 yes no] 0 {return 1} 1 {return 0}
}
#
proc tellError {net t m} {
    switch {} $net {} default {
	if [listmember [$net toInfo] ERROR] {$net inform $m ; return}
    }
    global ztrans
    tk_dialog .@[newName te] $t $m error 0 $ztrans(ok)
}
#
proc tellInfo {t m} {
    global ztrans
    tk_dialog .@[newName ti] $t $m info 0 $ztrans(ok)
}
