#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/dialog.tcl,v $
# $Date: 2001/07/10 15:36:13 $
# $Revision: 1.18.1.43 $
#
package provide zircon 1.18
#
proc doButtons {w plv pars} {
    set lv [lindex $plv 0]
    set param [lindex $plv 1]
    if {[llength $pars] > 0} {
	set arg [lindex $pars 0]
	frame $w.bot.0 -borderwidth 1 -relief raised
	grid $w.bot.0 -row 0 -column 0 -padx 5 -padx 5
	switch {} [set cmd [lindex $arg 1]] {} default {append cmd " $param"}
	switch {} $lv {} default {
	   bind $lv <Return> "$cmd ; killWindow $w ; break"
	   bind $lv <Tab> "focus $w.top.v1 ; break"
	}
	button $w.bot.0.button -text [trans [lindex $arg 0]] -width 7 \
		-command "$cmd ; killWindow $w"
	grid $w.bot.0.button -sticky ew -padx 5 -pady 5
	bind $w <Return> "$cmd ; killWindow %W ; break"
	set i 1
	foreach arg [lrange $pars 1 end] {
	    switch {} [set cmd [lindex $arg 1]] {} default {append cmd " $param"}
	    switch -glob -- [set lbl [lindex $arg 0]] {
	    -* {
		    set lbl [trans [string range $lbl 1 end]]
		    button $w.bot.$i -text $lbl -width 7 -command $cmd
		}
	    default {
		    button $w.bot.$i -text [trans $lbl] -width 7 \
		      -command "$cmd ; killWindow $w"
		}
	    }
	    grid $w.bot.$i -row 0 -column $i -padx 5 -pady 5
	    incr i
	}
    }
    switch {} $lv {set sf $w} default {set sf $w.top.v1}
    bind $w <Any-Enter> "focus $sf ; break"
    focus $sf
}
#
proc doEntries {w entries} {
    set param {}
    set vb 1
    set lv {}
    foreach entry $entries {
	set f $w.top
	set lv $f.v$vb
	set lb $f.l$vb
	switch {} [lindex $entry 2] {
	    label $lb -text [trans [lindex $entry 0]]
	} default {
	    menubutton $lb -text [trans [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 [lindex $entry 3]  palette {
	    bind $lv <Escape> "makePalette ${w}PL {} $lv {} {} {}"
	    bind $lv <ButtonPress-3> "popPalette ${w}PP {} $lv {} %X %Y"
	} secret {
	    $lv configure -show *
	}
	append param " \[$lv get\]"
	grid $lb -row $vb -column 0 -padx 5 -pady 5
	grid $lv -row $vb -column 1 -sticky ew -padx 10 -pady 10
	incr vb
	bind $lv <Return> "focus $w.top.v$vb ; break "
	bind $lv <Tab> "focus $w.top.v$vb ; break"
    }
    return [list $lv $param]
}
#
proc dialogWindow {w title} {
    makeToplevel $w $title {} {}
    wm transient $w [winfo toplevel [winfo parent $w]]
    grid columnconfigure $w 0 -weight 1
    grid rowconfigure $w 0 -weight 1
#
    grid [frame $w.top -relief raised] -sticky nsew
    grid columnconfigure $w.top 1 -weight 1
    grid rowconfigure $w.top 0 -weight 1
#
    grid [frame $w.bot -relief raised] -sticky ew
}
#
proc dialogPosn {w} {
    set sh [winfo screenheight $w]
    set sw [winfo screenwidth $w]
    wm geometry $w +[expr {($sw - [winfo reqwidth $w])/ 2}]+[expr {($sh - [winfo reqheight $w])/ 2}]
}
#
proc mkDialog {kind w title msgText entries args} {
    switch {} $args {
	set args [list [list [trans 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 {[set ti [listmember [$net toInfo] $kind]] || [listmember [$net alwayslog] $kind]} {
	    $net inform $msgText
	    if {$ti} { return {} }
	}
    }
    switch {} $w {set w .@[newName dlg]} default {killWindow $w}
    dialogWindow $w $title
    message $w.top.message -justify center -text $msgText -aspect 800
    grid $w.top.message - -sticky nsew
    set lv [doEntries $w $entries]
    doButtons $w $lv $args
    dialogPosn $w
    catch {tkwait visibility $w ; grab $w}
    return $w
}
#
proc mkEntryBox {w title msgText entries args} {
    switch {} $args {
	set args [list [list [trans dismiss] {}]]
    }
    switch {} $w { set w .@[newName dlg] } default {killWindow $w}
    dialogWindow $w $title
    grid [message $w.top.message -text $msgText -aspect 800] - -sticky nsew
    set lv [doEntries $w $entries]
    doButtons $w $lv $args
    dialogPosn $w
    return $w
}
#
proc mkRadioBox {w title msgText flags dflag entries args} {
    global RFlags
    killWindow $w
    dialogWindow $w $title
    message $w.top.message -text $msgText -aspect 800
    grid $w.top.message - -sticky nsew
    set lv [doEntries $w $entries]
    set f [frame $w.top.flg]
    set i 0
    foreach entry $flags {
	radiobutton $f.rb$entry -text [trans $entry] -value $entry -variable RFlags($w)
	grid $f.rb$entry -row 0 -column $i
	incr i
    }
    set RFlags($w) $dflag
    grid $w.top.flg - -sticky ew -padx 5 -pady 5
    set param [lindex $lv 1]
    append param " RFlags $w"
    doButtons $w [list [lindex $lv 0] $param] $args
    dialogPosn $w
    return $w
}
#
proc mkInfoBox {net kind w title msgText args} {
    switch {} $args {
	set args [list [list [trans dismiss] {}]]
    }
    switch {} $kind {} default {
	if {[listmember [$net noConfirm] $kind]} {
	    if {[llength $args] > 0} {eval [lindex [lindex $args 0] 1] }
	    return [[$net info] text]
	}
	if {[set ti [listmember [$net toInfo] $kind]] || [listmember [$net alwayslog] $kind]} {
	    $net inform $msgText
	    if {$ti} { return [[$net info] text] }
	}
    }
    set just [expr {[listmember {WHO INFO LINKS} $kind] ? {left} : {center}}]
    switch {} $w {set w .@[newName ifb]} default {killWindow $w}
    dialogWindow $w $title
    bind $w.top <Destroy> break
    set frm $w.top.message
    switch left $just {
	frame $frm
	grid columnconfigure $frm 0 -weight 1
	grid rowconfigure $frm 0 -weight 1
	set txt $frm.text
	scrollbar $frm.vs -command "$txt yview"
	scrollbar $frm.hs -command "$txt xview" -orient horizontal
	text $txt -width 80 -height 10 -wrap none \
	  -xscrollcommand "$frm.hs set" -yscrollcommand "$frm.vs set"
	bindtags $txt ROText
	switch {} $msgText {} default {
	    $txt insert insert $msgText
	    set ln [lindex [split [$txt index end] .] 0]
	    set ln [expr {$ln > 24 ? 24 : $ln}]
	    $txt conf -height $ln
	}
	grid $frm.text -row 0 -column 0 -sticky nsew
	grid $frm.vs -row 0 -column 1 -sticky ns
	grid $frm.hs -row 1 -column 0 -sticky ew
    } default {
	message $frm -justify $just -text $msgText -aspect 800
	set txt $frm
    }
    grid $frm - -sticky nsew
    doButtons $w [list {} {}] $args
    dialogPosn $w
    return $txt
}
#
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.e4 $init
	fillFile $w $fn
    } {
	eval $cmd $fn
	killFWindow $w
    }
}
#
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
    set FBFilter($w) $filter
    makeToplevel $w $title "catch {unset FBFilter($w)}" {}
    wm transient $w [winfo toplevel [winfo parent $w]]
    frame $w.top -relief raised
    frame $w.mid -borderwidth 0
    frame $w.bot -relief raised
    grid $w.top -sticky nsew
    grid $w.mid -sticky nsew
    grid columnconfigure $w.mid 1 -weight 1
    grid $w.bot -sticky ew
    switch {} $msgText {} default {
	grid [message $w.top.message -text $msgText -aspect 800] - -sticky nsew
    }
    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
    grid $w.mid.dir - -sticky ew -padx 5
    makeLB $w.mid.flist
    grid $w.mid.flist - -sticky nsew
    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"
    grid $w.mid.shall -
    glabelEntry 0 3 0 $w.mid "-text [trans filter]" {.*} "setFilter %W {$init} $dirv; break"
    glabelEntry 0 4 0 $w.mid "-text [trans filename]" $init \
      "checkFile $w \[%W get\] {$cmd} {$init} $dirv; killFWindow $w ; break"
    fillFile $w $direct
    bind $w.mid.flist.l <1> "
	set x \[%W nearest %y\]
	set f \[%W get \$x\]
	entrySet $w.mid.e4 \
	 \[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
	grid $w.bot.0 -row 0 -column 0 -padx 5 -pady 5
	set cmd [lindex $arg 1]
	switch {} $cmd {} default {append cmd " \[file join \[set $dirv\] \[$w.mid.e4 get\]\]"}
	button $w.bot.0.button -text [trans [lindex $arg 0]] \
		-command "$cmd ; killFWindow $w"
	grid $w.bot.0.button -padx 5 -pady 5
	bind $w <Return> "$cmd ; killFWindow %W ; 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.e4 get\]\]"}
	    button $w.bot.$i -text [trans [lindex $arg 0]] \
	      -command "$cmd ; killFWindow $w"
	    grid $w.bot.$i -row 0 -column $i
	    incr i
	}
    }
    bind $w <Any-Enter> {focus %W ; break}
    dialogPosn $w
    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} {
    if {[tk_dialog .@[newName wu] $t $m warning 0 ok cancel] == 0} {return 1}
    return 0
}
#
proc askUser {kind t m} {
    switch {} $kind {} default {
	global currentNet
	if {[listmember [$currentNet noConfirm] $kind]} { return 1 }
    }
    if {[tk_dialog .@[newName au] $t $m question 0 yes no] == 0} {return 1}
    return 0

}
#
switch -glob -- 8* [info tclversion] {
proc tellError {net t m args} {
    switch {} $args {set kind ERROR} default { set kind [lindex $args 0]}
    switch {} $net {} default {
	if {[set ti [listmember [$net toInfo] $kind]] || [listmember [$net alwayslog] $kind]} {
	    $net inform $m
	    if {$ti} return
	}
    }
    tk_messageBox -icon error -title $t -message $m -type ok
}
#
proc tellInfo {net t m args} {
    switch {} $args {} default {
	set kind [lindex $args 0]
	if {[set ti [listmember [$net toInfo] $kind]] || [listmember [$net alwayslog] $kind]} {
	    $net inform $m
	    if {$ti} return
	}
    }
    tk_messageBox -icon info -title $t -message $m -type ok
}
} default {
proc tellError {net t m args} {
    switch {} $args { set kind ERROR } default { set kind [lindex $args 0]}
    switch {} $net {} default {
	if {[set ti [listmember [$net toInfo] $kind]] || [listmember [$net alwayslog] $kind]} {
	    $net inform $m
	    if {$ti} return
	}
    }
    tk_dialog .@[newName te] $t $m error 0 [trans ok]
}
#
proc tellInfo {net t m args} {
    switch {} $args {} default {
	set kind [lindex $args 0]
	if {[set ti [listmember [$net toInfo] $kind]] || [listmember [$net alwayslog] $kind]} {
	    $net inform $m
	    if {$ti} return
	}
    }
    tk_dialog .@[newName ti] $t $m info 0 [trans ok]
}
}

