# dialog.tcl
# Dialog templates

proc DialogSelf {parent frame} {
    set top [winfo toplevel $parent]
    if {[string compare $top "."] == 0} {
	set self $frame
    } else {
	set self $top$frame
    }
    return $self
}

proc Dialog_Shell {parent frame title msg buttonList} {
    set t [DialogSelf $parent $frame]
    if [winfo exists $t] {
	raise $t
	wm deiconify $t
    } else {
	toplevel $t -class Dialog -bd 4 -relief ridge
	wm title $t $title
	wm geometry $t +[winfo rootx $parent]+[winfo rooty $parent]
	message $t.msg -text $msg -aspect 2000
	pack $t.msg -padx 10 -pady 10
	frame $t.body ; pack $t.body -fill both -expand true
	frame $t.but -bd 5 ; pack $t.but
	set i 0
	foreach b $buttonList {
	    lassign {text cmd} $b
	    button $t.but.$i -text $text -command $cmd
	    pack $t.but.$i -side left -padx 10
	    incr i
	}
    }
    return $t.body
}
proc DialogEntry {parent frame msg okProc entryList {hook DialogNoHook}} {
    set f [DialogSelf $parent $frame]
    upvar #0 $f data
    frame $f -bd 4 -relief ridge -class Dialog
    message $f.msg -text $msg -aspect 1000

    set b [frame $f.b -bd 10]
    button $b.ok -text OK -command [list set $f\(status) 1]
    button $b.cancel -text Cancel -command [list set $f\(status) 0]
    pack $b.ok -side left
    pack $b.cancel -side right
    pack $f.msg -side top -fill x -padx 10
    pack $f.b -side bottom -fill x -padx 10

    set data(b) $b
    set data(max) 0
    foreach item $entryList {
	set name [lindex $item 0]
	set len [string length $name]
	if {$len > $data(max)} {
	    set data(max) $len
	}
    }
    incr data(max) +1
    set focus 0
    set i 0
    foreach item $entryList {
	set name [lindex $item 0]
	set default [lindex $item 1]
	set g [DialogEntryAdd $parent $frame $name $default $i]
	if !$focus {
	    focus $g.entry
	    set focus 1
	}
	incr i
    }
    set data(status) 0
    eval $hook {$f}
    raise [winfo toplevel $parent]
    place $f -in $parent -relx .5 -rely .5 -anchor center
    Platform_WaitVisibility $f
    DialogGrab $f
    tkwait variable $f\(status)
    DialogGrab release $f
    focus $parent
    catch {destroy $f}
    if {$data(status)} {
	set x {}
	set values [array names data X,*]
	set len [string length X,]
	if {[llength $values] > 1} {
	    foreach item $values {
		set name [string range $item $len end]
		lappend x $name $data($item)
	    }
	} else {
	    set name [string range [lindex $values 0] $len end]
	    set x $data([lindex $values 0])
	}
	eval $okProc {$x}
    } else {
	return {} 
    }
}
proc DialogEntryAdd {parent frame name default {i 0}} {
    set f [DialogSelf $parent $frame]
    upvar #0 $f data
    set data(X,$name) $default
    while {[winfo exists $f.x$i]} {
	incr i
    }
    set g [frame $f.x$i -bd 4 -relief flat]
    label $g.label -width $data(max) -anchor w -text \
	[string toupper [string range $name 0 0]][string range $name 1 end]
    entry $g.entry -textvar $f\(X,$name) -relief sunken -width 35
    bind $g.entry <Return> "$data(b).ok flash ; $data(b).ok invoke"
    bind $g.entry <Control-c> "$data(b).cancel flash ; $data(b).cancel invoke"
    pack $g.label -side left
    pack $g.entry -side top -fill x
    pack $g -side top -fill x
    return $g
}

proc DialogConfirm {parent frame msg {okProc { }} {cancelProc { }} {ok OK} {cancel Cancel}} {
    set self [DialogSelf $parent $frame]
    global $self.status
    if [winfo exists $self] {
	set $self.status 0	;# so other dialog cancels
	eval $cancelProc		;# so we cancel
	catch {destroy $self}
	return 0
    }
    set f [frame $self -bd 4 -relief ridge -class Dialog]
    message $f.msg -text $msg -aspect 1000
    set b [frame $f.b]
    set $self.status 0
    button $b.ok -text $ok -command [list set $self.status 1]
    button $b.cancel -text $cancel -command [list set $self.status 0]
    pack $f.msg $f.b -side top -fill x -padx 10
    pack $b.ok -side left -padx 10 -pady 10
    pack $b.cancel -side right -padx 10 -pady 10
    place $f -in $parent -relx .5 -rely .5 -anchor center
    raise [winfo toplevel $f]
    Platform_WaitVisibility $f
    DialogGrab $f
    tkwait variable $self.status
    catch {
	DialogGrab release $f
	focus $f
	destroy $f
    }
    if [set $self.status] {
	eval $okProc
	return 1
    } else {
	eval $cancelProc
	return 0
    }
}
proc DialogInfo {parent msg } {
    set self [DialogSelf $parent .dialoginfo]
    global $self.status
    set f [frame $self -bd 4 -relief ridge -class Dialog]
    message $f.msg -text $msg -aspect 1000 -justify center
    set b [frame $f.b]
    set $self.status 0
    button $b.ok -text OK -command "destroy $self"
    pack $f.msg $f.b -side top -fill x -padx 10
    pack $b.ok -side top -padx 10 -pady 10
    place $f -in $parent -relx .5 -rely .5 -anchor center
    raise [winfo toplevel $f]
    Platform_WaitVisibility $f
    DialogGrab $f
    tkwait window $self
    focus $parent
}

proc DialogHtmlInfo {parent html } {
    if {[string length $parent] == 0} {
	catch {destroy .tmp}
	toplevel .tmp
	wm title .tmp "WebTk Message"
	set self .tmp.dialoginfo
    } else {
	set self [DialogSelf $parent .dialoginfo]
    }
    global $self.status
    set f [frame $self -bd 4 -relief ridge -class Dialog]
    set win [text $f.msg -width 40 -height 15]

    set b [frame $f.b]
    set $self.status 0
    button $b.ok -text OK -command "destroy $self"
    pack $f.msg $f.b -side top -fill x -padx 10
    pack $f.msg -fill both -expand true
    pack $b.ok -side top -padx 10 -pady 10
    if {[string length $parent] == 0} {
	pack $f -fill both -expand true
	$b.ok config -command "destroy .tmp"
	set self .tmp
    } else {
	place $f -in $parent -relx .5 -rely .5 -anchor center
	raise [winfo toplevel $f]
    }
    if [catch {
	HMinit_win $win
	HMreset_win $win
	HMparse_html $html [list HMrender $win]
	$win config -state disabled
    } err] {
	catch {$win insert insert $err}
    }
    Platform_WaitVisibility $f
    DialogGrab $f
    catch {tkwait window $self}
    focus $parent
}

proc DialogChoice {parent frame msg buttonlist {keylist {}}} {
    set f [DialogSelf $parent $frame]
    global $f.status
    if [winfo exists $f] {
	raise $f
	return
    }
    frame $f -bd 4 -relief ridge -class Dialog]
    message $f.msg -text $msg -aspect 1000
    set b [frame $f.b]
    pack $f.msg $f.b -side top -padx 10

    set $f.status 0
    set i 0
    foreach item $buttonlist {
	set key [lindex $keylist $i]
	if {$key != {}} {
	    append item \n$key
	    bind $f $key "$b.$i flash ; $b.$i invoke"
	}
	button $b.$i -text $item \
	    -command [list set $f.status $i]
	pack $b.$i -side left -padx 10 -pady 10
	incr i
    }
    place $f -in $parent -relx .5 -rely .5 -anchor center
    raise [winfo toplevel $f]
    Platform_WaitVisibility $f
    focus $f
    DialogGrab $f
    tkwait variable $f.status
    DialogGrab release $f
    focus $parent
    destroy $f
    update idletasks
    return [set $f.status]
}

# Edit an HTML tag
# spec is a template for all the required and optional paramters
# values is the current value of the htag

proc Dialog_Htag { win spec values message {hook DialogNoHook}} {
    global HMtagMenu
    upvar #0 DialogHtag$win dialog

    dputs Dialog_Htag spec $spec values $values
    if [info exists dialog(name)] {
	set lastname $dialog(name)
    }
    Mark_SplitTag $spec htag spec
    if [winfo exists $win.htagdialog] {
	if {$dialog(_complete) == 0} {
	    DialogHtagCancel $win
	    return ""	;# Unsafe to do anything but return
	}
	eval destroy [winfo children $win.htagdialog]
	set f $win.htagdialog
	wm deiconify $f
    } else {
	set f [toplevel $win.htagdialog -class Dialog -bd 4 -relief ridge]
	wm title $f "Properties for <$htag>"
	wm geometry $f +[winfo rootx $win]+[winfo rooty $win]
	wm protocol $f WM_DELETE_WINDOW [list DialogHtagCancel $win 1]
    }
    catch {unset dialog}
    message $f.msg -aspect 800 -textvar DialogHtag$win\(_message\)
    set dialog(_message) $message
    pack $f.msg -padx 10 -pady 10

    set i 0
    set dialog(_complete) 0
    set dialog(_names) {}
    set dialog(_values) $values
    set lastentry {}
    set firstentry {}

    foreach  item $spec {
	# Parse one item of the spec, an attr=value item
	set parts [split $item =]
	set field [string trim [lindex $parts 0] \" ]
	set value [string trim [lindex $parts 1] \" ]
	lappend dialog(_names) $field
	if {"$field" == "name" &&
	    [regexp {^!?$} $value] && [info exists lastname]} {
	    set dialog(name)  $lastname
	} else {
	    set dialog($field) $value
	}
	# value = ! indicates a required field
	if {[string compare $value !] == 0} {
	    set dialog(required,$field) 1
	    set dialog($field) ""
	    set star " *"
	} else {
	    set dialog(required,$field) 0
	    set star ""
	}
	# Extract the value from the existing htag, if any
	catch {unset x}
	if {[HMextract_param $values $field x] && [info exists x]} {
	    set dialog($field) $x
	}
	# Display the field=value pair
	set g [frame $f.f$i -relief flat -bd 1]
	label $g.label -text $field$star -width 10 -anchor w
	entry $g.entry -textvariable DialogHtag$win\($field\) \
		-relief sunken -width 40
	pack $g.label -side left
	pack $g.entry -side top -fill x
	pack $g -side top -fill x -padx 10
	incr i
	bind $g.entry <Return> "$f.but.ok flash ; $f.but.ok invoke"
	bind $g.entry <Control-c> "$f.but.cancel flash ; $f.but.cancel invoke"
	if {$lastentry == {}} {
	    set firstentry $g.entry
	} else {
	    bind $lastentry <Tab> "focus $g.entry ; break"
	}
    }
    if {$lastentry != {}} {
	bind $lastentry <Tab> "focus $firstentry ; break"
    }
    set g [frame $f.but -relief flat -bd 10]
    button $g.ok -text OK\n<Return> -command [list DialogHtagOK $win]
    button $g.cancel -text Cancel\n<Control-c> -command [list DialogHtagCancel $win]
    pack $g -side bottom -fill x
    pack $g.ok -side left
    pack $g.cancel -side right

    focus $f.f0.entry

    set cookie [eval $hook $f DialogHtag$win]
    tkwait variable DialogHtag$win\(_complete\)
    focus $win
    if {$dialog(_complete) < 0} {
	return {}
    }
    set p {}
    set sep ""
    foreach param $dialog(_names) {
	set value [string trim $dialog($param)]
	if {[string compare $value _SINGLETON_] == 0} {
	    append p $sep $param
	} elseif {[string compare $value {""}] == 0} {
	    append p $sep $param= \" \"
	} elseif {[string length $value]} {
	    append p $sep $param= \" [string trim $value \"] \"
	}
	set sep " "
    }
    return [list $htag $p $cookie]
}
proc DialogNoHook { frame {dialogVar {}} } {
#    upvar $dialogVar dialog
    return {}
}

proc DialogHtagOK { win } {
    upvar #0 DialogHtag$win dialog
    set bad {}
    foreach param $dialog(_names) {
	if {$dialog(required,$param)  &&
	    [regexp {^!?$} [string trim $dialog($param)]]} {
	    lappend bad $param
	}
    }
    if {[llength $bad] == 0} {
	set dialog(_complete) 1
	wm withdraw $win.htagdialog
    } else {
	set dialog(_message) "These items must have values:\n$bad"
    }
}
proc DialogHtagCancel { win {destroy 1}} {
    upvar #0 DialogHtag$win dialog
    set dialog(_complete) -1
    if $destroy {
#	wm withdraw $win.htagdialog
	destroy $win.htagdialog
    }
}

# Display an HTML error from the server
proc DialogHtmlError { html } {
    catch {destroy .tophtml}
    set t [toplevel .tophtml]
    wm title .tophtml "HTML message"
    set win [text $t.text -width 60 -height 20] ; pack $win
    frame $t.status ; label $t.status.msg	;# Fake out status messages
    HMinit_win $win				;# Reset display engine
    HMset_state $win -insert insert		;# We use the "insert" mark
    HMset_state $win -size 4			;# font size adjustment
    HMset_indent $win 1.2			;# tab spacing (cm)
    HMreset_win $win
    Mark_Reset $win
    bindtags $win [list $win TScroll all]	;# Disable the widget
    HMparse_html $html [list HMrender $win]
    set title [wm title .tophtml]
    append title " (click to dismiss)"
    wm title .tophtml $title
    bind $win <Button-1> {destroy .tophtml}
}

proc DialogGrab {args} {
    catch {eval grab $args}
}
