# copyright (C) 1997-2006 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

# $Id: dialog.tcl,v 2.29 2006/01/28 19:16:59 jfontain Exp $


class dialogBox {}

proc dialogBox::dialogBox {this parentPath args} composite {[new toplevel $parentPath] $args} {
    set path $widget::($this,path)
    wm group $path .                                                 ;# for proper window manager (windowmaker for example) behavior
    wm withdraw $path        ;# hide the window till all contained widgets are created so we will be able to know its requested size
    composite::manage $this [new frame $path -relief sunken -borderwidth 1 -height 2] separator [new frame $path] buttons
    set buttons $composite::($this,buttons,path)
    composite::manage $this [new button $buttons -text [mc OK]] ok [new button $buttons -text [mc Cancel]] cancel\
        [new button $buttons -text [mc Help]] help [new button $buttons -text [mc Close]] close
    grid $composite::($this,separator,path) -column 0 -row 1 -sticky ew -pady 2
    grid $buttons -column 0 -row 2 -sticky nsew
    grid rowconfigure $path 0 -weight 1
    grid columnconfigure $path 0 -weight 1
    wm protocol $path WM_DELETE_WINDOW "dialogBox::close $this"
    composite::complete $this
}

proc dialogBox::~dialogBox {this} {
    if {[string length $composite::($this,-deletecommand)] > 0} {
        uplevel #0 $composite::($this,-deletecommand)                                       ;# always invoke command at global level
    }
}

proc dialogBox::options {this} {
    return [list\
        [list -buttons o]\
        [list -command {} {}]\
        [list -closecommand {} {}]\
        [list -default {} {}]\
        [list -deletecommand {} {}]\
        [list -die 1 1]\
        [list -enterreturn 1 1]\
        [list -grab local]\
        [list -helpcommand {} {}]\
        [list -labels {} {}]\
        [list -otherbuttons {} {}]\
        [list -title {Dialog box}]\
        [list -transient 1]\
        [list -x 0]\
        [list -y 0]\
    ]
}

proc dialogBox::set-buttons {this value} {
    set path $widget::($this,path)
    if {$composite::($this,complete)} {
        error {option -buttons cannot be set dynamically}
    }
    if {![regexp {^[chox]+$} $value]} {
        error "bad buttons value \"$value\": must be a combination of c, h, o and x"
    }
    if {[string first h $value] >= 0} {
        set button $composite::($this,help,path)
        pack $button -side left -expand 1 -pady 3 -padx 3
        widget::configure $composite::($this,help) -command "dialogBox::help $this"
        bind $path <KeyPress-F1> "$button configure -relief sunken"
        bind $path <KeyRelease-F1> "$button configure -relief raised; dialogBox::help $this"
    }
    set ok [expr {[string first o $value] >= 0}]
    if {$ok} {
        set button $composite::($this,ok,path)
        pack $button -side left -expand 1 -pady 3
        widget::configure $composite::($this,ok) -command "dialogBox::oked $this"
        updateOKBindings $this
    }
    set cancel [expr {[string first c $value] >= 0}]
    if {$cancel} {
        set button $composite::($this,cancel,path)
        pack $button -side left -expand 1 -pady 3
        widget::configure $composite::($this,cancel) -command "dialogBox::close $this"
        bind $path <KeyPress-Escape> "$button configure -relief sunken"
        bind $path <KeyRelease-Escape> "$button configure -relief raised; dialogBox::close $this"
    }
    if {[string first x $value] >= 0} {
        set button $composite::($this,close,path)
        pack $button -side left -expand 1 -pady 3
        widget::configure $composite::($this,close) -command "dialogBox::close $this"
        set keys {}
        if {!$ok} {
            foreach key {Return KP_Enter} {
                bind $path <KeyPress-$key> "$button configure -relief sunken"
                bind $path <KeyRelease-$key> "$button configure -relief raised; dialogBox::close $this 1"
            }
        }
        if {!$cancel} {
            bind $path <KeyPress-Escape> "$button configure -relief sunken"
            bind $path <KeyRelease-Escape> "$button configure -relief raised; dialogBox::close $this 1"
        }
    }
}

proc dialogBox::set-otherbuttons {this value} {
    if {$composite::($this,complete)} {
        error {option -default cannot be set dynamically}
    }
    set buttons $composite::($this,buttons,path)
    foreach name $value {
        composite::manage $this [new button $buttons -text $name] $name                        ;# user can change default text later
        pack $composite::($this,$name,path) -side left -expand 1 -pady 3 -padx 3
    }
}

proc dialogBox::set-default {this value} {                                                 ;# value is stored at the composite level
    if {$composite::($this,complete)} {
        error {option -default cannot be set dynamically}
    }
    switch $composite::($this,-default) {
        o {$composite::($this,ok,path) configure -default active}
        c {$composite::($this,cancel,path) configure -default active}
        x {$composite::($this,close,path) configure -default active}
        default {
            error "bad default value \"$value\": must be o, c or x"
        }
    }
}

proc dialogBox::set-command {this value} {}                                  ;# do nothing, values are stored at the composite level
# last chance to prevent dialog box closing. use a procedure that returns a boolean, true if closing is allowed:
proc dialogBox::set-closecommand {this value} {}
proc dialogBox::set-deletecommand {this value} {}
proc dialogBox::set-die {this value} {}
proc dialogBox::set-helpcommand {this value} {}

proc dialogBox::set-enterreturn {this value} {
    updateOKBindings $this
}

proc dialogBox::set-grab {this value} {
    switch $value {
        global {grab -global $widget::($this,path)}
        local {grab $widget::($this,path)}
        release {grab release $widget::($this,path)}
        default {
            error "bad grab value \"$value\": must be global, local or release"
        }
    }
}

proc dialogBox::set-title {this value} {
    wm title $widget::($this,path) $value
}

foreach option {-x -y} {
    proc dialogBox::set$option {this value} {
        if {[winfo ismapped $widget::($this,path)]} {
            place $this                            ;# if window if not visible, it will be positioned at the time it becomes visible
        }
    }
}

proc dialogBox::set-transient {this value} {
    if {$value} {
        wm transient $widget::($this,path) .
    } else {
        wm transient $widget::($this,path) {}
    }
}

proc dialogBox::set-labels {this value} {                                       ;# flat list of button code, label, button code, ...
    foreach {code label} $value {
        switch $code {
            c {composite::configure $this cancel -text $label}
            h {composite::configure $this help -text $label}
            o {composite::configure $this ok -text $label}
            x {composite::configure $this close -text $label}
            default {error "bad button code \"$code\": must be c, h, o or x"}
        }
    }
}

proc dialogBox::display {this path} {                                                ;# must be invoked for dialog box to be visible
    if {[string length $path] == 0} {                                                         ;# undisplay, remove related resources
        if {[info exists ($this,displayed)]} {
            grid forget $($this,displayed)
            unset ($this,displayed)
        }
        return
    }
    if {[info exists ($this,displayed)]} {
        error "a widget ($($this,displayed)) is already displayed"
    }
    set ($this,displayed) $path
    grid $path -in $widget::($this,path) -column 0 -row 0 -sticky nsew
    place $this
}

proc dialogBox::oked {this {enterOrReturn 0}} {                         ;# whether Enter or Return key is at the origin of the event
    if {\
        $enterOrReturn &&\
        (!$composite::($this,-enterreturn) || [string equal [widget::cget $composite::($this,ok) -state] disabled])\
    } return                                                                              ;# also do nothing when button is disabled
    if {[string length $composite::($this,-command)] > 0} {                          ;# invoke eventually command for the dialog box
        uplevel #0 $composite::($this,-command)                            ;# always invoke command at global level as tk buttons do
    }
    if {[info exists composite::($this,-die)] && $composite::($this,-die)} {
        delete $this                                                        ;# dialog box may already have been destroyed in command
    }
}

proc dialogBox::close {this {enterOrReturn 0}} {
    if {\
        $enterOrReturn &&\
        (!$composite::($this,-enterreturn) || [string equal [widget::cget $composite::($this,close) -state] disabled])\
    } return                                                                              ;# also do nothing when button is disabled
    if {([string length $composite::($this,-closecommand)] > 0) && ![uplevel #0 $composite::($this,-closecommand)]} return
    delete $this
}

proc dialogBox::place {this} {                                                          ;# make sure no part of widget is off screen
    update idletasks                                                                                 ;# make sure sizes are accurate
    set path $widget::($this,path)
    set x [minimum $composite::($this,-x) [expr {[winfo screenwidth $path] - [winfo reqwidth $path]}]]
    set y [minimum $composite::($this,-y) [expr {[winfo screenheight $path] - [winfo reqheight $path]}]]
    wm geometry $path +$x+$y
    wm deiconify $path                                                                                        ;# now show the window
}

proc dialogBox::help {this} {
    if {[string length $composite::($this,-helpcommand)] > 0} {                                    ;# eventually invoke help command
        uplevel #0 $composite::($this,-helpcommand)                        ;# always invoke command at global level as tk buttons do
    }
}

proc dialogBox::updateOKBindings {this} {
    set path $widget::($this,path)
    if {$composite::($this,-enterreturn)} {
        set button $composite::($this,ok,path)
        foreach key {Return KP_Enter} {
            bind $path <KeyPress-$key> "$button configure -relief sunken"
            bind $path <KeyRelease-$key> "$button configure -relief raised; dialogBox::oked $this 1"
        }
    } else {
        foreach key {Return KP_Enter} {
            bind $path <KeyPress-$key> {}
            bind $path <KeyRelease-$key> {}
        }
    }
}
