##  Shell dialog widget.
#
#   This class implements a shell which is a top level widget
#   giving a childsite and providing activate, deactivate, and center 
#   methods.
#
# Copyright (c) 2021 <r.zaumseil@freenet.de>

##  Common variable definition.
namespace eval ::tko::dialog {
    ##  Stack used in grab() functions.
    variable grabstack {}

    ## Specific dialog button options
    variable f
    foreach f [glob -tails -dir $::tko(libdir) imgs/*.png] {
        image create photo tko:$f -format png -file $::tko(libdir)/$f
    }
    catch unset f
    variable buttonargs
    array set buttonargs [list\
ok      [list -image tko:imgs/tick.png -text [::msgcat::mc {Ok}]]\
cancel  [list -image tko:imgs/cross.png -text [::msgcat::mc {Cancel}]]\
return  [list -image tko:imgs/cross-white.png -text [::msgcat::mc {Return}]]\
yes     [list -image tko:imgs/thumb-up.png -text [::msgcat::mc {Yes}]]\
no      [list -image tko:imgs/thumb.png -text [::msgcat::mc {No}]]\
add     [list -image tko:imgs/plus-circle.png -text [::msgcat::mc {Add}]]\
apply   [list -image tko:imgs/tick-circle.png -text [::msgcat::mc {Apply}]]\
delete  [list -image tko:imgs/minus-circle.png -text [::msgcat::mc {Delete}]]\
reset   [list -image tko:imgs/arrow-circle.png -text [::msgcat::mc {Reset}]]\
use     [list -image tko:imgs/arrow.png -text [::msgcat::mc {Use}]]\
useall  [list -image tko:imgs/plus.png -text [::msgcat::mc {Use all}]]\
    ]
}

##  Dialog widget style of newly created dialog widget.
# One of: toplevel, frame, labelframe
set ::tko::dialog toplevel

#-------------------------------------------------------------------------------

#=== CLASS =====================================================================

#-------------------------------------------------------------------------------

##  Shell dialog widget.
::oo::class create ::tko::dialog {
    ::tko_createwidget
    # Internal data
    if {[catch {private variable _tko}]} {
        variable _tko
    }
}

#-------------------------------------------------------------------------------

##  Background of button box.
::oo::define ::tko::dialog ::tko_option -class class Class TkoDialog {error readonly} {}

#-------------------------------------------------------------------------------

##  Background of button box.
::oo::define ::tko::dialog ::tko_option -buttonboxbg buttonboxbg Buttonboxbg {} {
    if {$tko(-buttonboxbg) eq {}} {
        set tko(-buttonboxbg) [$_tko(.bb) cget -background]
    } else {
        $_tko(.bb) configure -background $tko(-buttonboxbg)
    }
}

#-------------------------------------------------------------------------------

##
# ok|cancel|return|yes|no|add|apply|delete|reset|use|useall
::oo::define ::tko::dialog ::tko_option -buttons buttons Buttons {} {
    my button clear
    foreach myButton $tko(-buttons) {
        my button define $myButton {*}$::tko::dialog::buttonargs($myButton)\
            -command    [list [self] deactivate $myButton]
    }
    my button show {*}$tko(-buttons)
}

#-------------------------------------------------------------------------------

##  Window icon definition.
::oo::define ::tko::dialog ::tko_option -geometry geometry Geometry {} {
    if {$::tko::dialog eq {toplevel}} {
        wm geometry $tko(.) $tko(-geometry)
    }
}

#-------------------------------------------------------------------------------

##  Window icon definition.
::oo::define ::tko::dialog ::tko_option -icon icon Icon {} {
    if {$::tko::dialog eq {toplevel}} {
        if {$tko(-icon) ne {}} {
            wm iconphoto $tko(.) $tko(-icon)
        }
    } else {
        $_tko(.h) configure -image $tko(-icon)
    }
}

#-------------------------------------------------------------------------------

##  Window icon definition.
::oo::define ::tko::dialog ::tko_option -minsize minsize Minsize {} {
    if {$::tko::dialog eq {toplevel}} {
        wm minsize $tko(.) {*}$tko(-minsize)
    }
}
#-------------------------------------------------------------------------------

##  Specifies the master window for the shell.
#   The window manager is informed that the shell is a transient window.
::oo::define ::tko::dialog ::tko_option -master master Master {} {
}

#-------------------------------------------------------------------------------

##  Specify the modality of the dialog.
::oo::define ::tko::dialog ::tko_option -modality modalite Modality none {
    if {$tko(-modality) ni {none application global {}}} {
        return -code error [::msgcat::mc {wrong -modality: %1$s} $tko(-modality)]
    }
}

#-------------------------------------------------------------------------------

##  Window title setting.
::oo::define ::tko::dialog ::tko_option -title title Title {} {
    if {$::tko::dialog eq {toplevel}} {
        wm title $tko(.) $tko(-title)
    } else {
        $_tko(.h) configure -text $tko(-title)
    }
}
 
#-------------------------------------------------------------------------------

::oo::define ::tko::dialog destructor {
    my _tko_destructor
}

#-------------------------------------------------------------------------------

## Create new dialog widget.
#
# \param args   Configuration arguments.
::oo::define ::tko::dialog constructor {args} {
    my _tko_constructor $args $::tko::dialog {-class $tko(-class)}
    set _tko(result) {};# Result value of modal activation.
    set _tko(wait)       {}
    if {$::tko::dialog eq {toplevel}} {
        # Maintain a withdrawn state until activated.  
        wm withdraw $tko(.)
        # Bind the window manager delete protocol to deactivation of the 
        # widget.  This can be overridden by the user via the execution 
        # of a similar command outside the class.
        # \note 'destroy $tko(.)' crashes under windows
        wm protocol $tko(.) WM_DELETE_WINDOW "[self] deactivate; after 10 destroy $tko(.)"
    } else {
        my configure -borderwidth 2 -relief groove
        ::tko::grid 0 1 -sticky ew\
            ::ttk::label    [set _tko(.h) $tko(.).h]\
            -compound   left
        ::tko::grid 0 1 -sticky e\
            ::button    $tko(.).x\
            -image      imgs/icons/cross.png\
            -command     "[self] deactivate; after 10 destroy $tko(.)"\
            -relief     flat
    }

    # childsite
    ::tko::grid 1 1 -sticky nesw -cweight 1 -rweight 1\
        ::ttk::frame        [set _tko(.cs) $tko(.).cs]\
        -padding        {3 5 3 5}

    # separator
    ::tko::grid 2 1 -pady 3 -sticky ew\
    ::ttk::separator    $tko(.).sep\
        -orient         horizontal

    # buttonbox
    ::tko::grid 3 1 -sticky ew\
    ::frame         [set _tko(.bb) $tko(.).bb] -padx 3 -pady 3
    ::grid columnconfigure $_tko(.bb) 0 -weight 1

    my _tko_init
}

#-------------------------------------------------------------------------------

#=== PUBLIC ====================================================================

#-------------------------------------------------------------------------------

##  Return name of childsite frame widget.
::oo::define ::tko::dialog method childsite {} {return $_tko(.cs)}

#-------------------------------------------------------------------------------

##  Handling of buttons.
#
# \param mode See below:
#  - **define** *name args*
#  - **configure *name ?option ?value::msgcat::mc ..?*
#  - **delete** *name ..*
#  - **show** *name ..*
#  - **names**
#  - **path**
#  - **clear**
# \param args   Mode related arguments. See above.
::oo::define ::tko::dialog method button {mode args} {
    switch -- $mode {
        define {
            ::ttk::button $_tko(.bb).[lindex $args 0]\
                -compound left {*}[lrange $args 1 end]\
                -command  [list [self] deactivate [lindex $args 0]]
        }
        configure {$_tko(.bb).[lindex $args 0] configure {*}[lrange $args 1 end]}
        delete {foreach my $args {destroy $_tko(.bb).$my}}
        show {
            catch {grid forget {*}[winfo children $_tko(.bb)]}
            set i 0
            foreach my $args {
                ::grid $_tko(.bb).$my -row 1 -column [incr i] -padx 10 -pady 4 -sticky e
            }
        }
        names {regsub -all $_tko(.bb). [winfo children $_tko(.bb)] {}}
        path {return $_tko(.bb).$args}
        clear {destroy {*}[winfo children $_tko(.bb)]}
        default {
            return -code error "unknown mode '$mode', should be define, configure, delete, show, names, path or clear"
        }
    }
}

#-------------------------------------------------------------------------------

## Display the dialog and wait based on the modality.
# For application and global modal activations, perform a grab operation,
# and wait for the result. The result may be returned via an argument
# to the "deactivate" method.
#
# \param args Configuration arguments. See method configure.
::oo::define ::tko::dialog method activate {args} {
    if {[llength $args]} {my configure {*}$args}
    if {[winfo ismapped $tko(.)]} {
        raise $tko(.)
        return
    }
    if {$::tko::dialog eq {toplevel}} {
        if {($tko(-master) != {}) && [winfo exists $tko(-master)]} {
            wm transient $tko(.) $tko(-master)
            my center $tko(-master)
            if {$tko(-icon) eq {}} {;#TODO -icon does not work before center?
                catch {set tko(-icon) [$tko(-master) cget -icon]}
            }
        }
    } else {
        if {($tko(-master) != {}) && [winfo exists $tko(-master)]} {
            set myMaster $tko(-master)
        } else {
            set myMaster [winfo toplevel $tko(.)]
        }
        if {$tko(-geometry) ne {}} {
            lassign [split $tko(-geometry) x] x y
        } else {
            #lassign $tko(-minsize) x y
            lassign {} x y
        }
        set myArgs {-relx 0.5 -rely 0.5 -anchor c}
        if {$x ne {} && $x > 0} {lappend myArgs -width $x}
        if {$y ne {} && $y > 0} {lappend myArgs -height $y}
        place $tko(.) -in $myMaster {*}$myArgs
    } 
    
    set _tko(wait) 0
    raise $tko(.)
    if {$::tko::dialog eq {toplevel}} {wm deiconify $tko(.)}
    tkwait visibility $tko(.)

    # For some mysterious reason, Tk sometimes returns too late from the
    # "tkwait visibility", i.e. after the "deactivate" method was invoked,
    # i.e. after the dialog window already disappeared. This would lead to
    # an infinite vwait on _wait($this) further on. Trap this case.
    # See also 2002-03-15 message to the Tcl/Tk newsgroup.
    # Remark that tests show that if "raise" is given *after* "deiconify" 
    # (see above), "tkwait visibility" always returns duly on time.....
    if {![winfo ismapped $tko(.)]} {
        # means "deactivate" went already through the grab-release stuff.
        return $_tko(result)
    }

    # Need to flush the event loop.
    update idletasks
    if {$tko(-modality) == "application"} {
        if {$::tko::dialog::grabstack != {}} {
            grab release [lindex $::tko::dialog::grabstack end]
        }
        set err 1
        while {$err == 1} {
            set err [catch [list grab $tko(.)]]
            if {$err == 1} {
                after 1000
            }
        }
        lappend ::tko::dialog::grabstack [list grab $tko(.)]
        tkwait variable [my varname _tko](wait)
        return $_tko(result)
    } elseif {$tko(-modality) == "global" }  {
        if {$::tko::dialog::grabstack != {}} {
            grab release [lindex $::tko::dialog::grabstack end]
        }
        set err 1
        while {$err == 1} {
            set err [catch [list grab -global $tko(.)]]
            if {$err == 1} {
                after 1000
            }
        }
        lappend ::tko::dialog::grabstack [list grab -global $tko(.)]
        tkwait variable [my varname _tko](wait)
        return $_tko(result)
    }
}

#-------------------------------------------------------------------------------
 
## Deactivate the display of the dialog.
# The method takes an optional argument to passed to the "activate"
# method which returns the value.
# This is only effective for application and global modal dialogs.
#
# \param returnvalue
::oo::define ::tko::dialog method deactivate {{returnvalue {}}} {
    if {! [winfo ismapped $tko(.)]} {
        return
    }
    if {$tko(-modality) == "none"} {
        if {$::tko::dialog eq {toplevel}} {wm withdraw $tko(.)} else {place forget $tko(.)}
    } elseif {$tko(-modality) == "application"} {
        grab release $tko(.)
        if {$::tko::dialog::grabstack != {}} {
            if {[set ::tko::dialog::grabstack [lreplace $::tko::dialog::grabstack end end]] != {}} {
                 catch {eval [lindex $::tko::dialog::grabstack end]}
            }
        }
        if {$::tko::dialog eq {toplevel}} {wm withdraw $tko(.)} else {place forget $tko(.)}
    } elseif {$tko(-modality) == "global"} {
        grab release $tko(.)
        if {$::tko::dialog::grabstack != {}} {
            if {[set ::tko::dialog::grabstack [lreplace $::tko::dialog::grabstack end end]] != {}} {
                 catch {eval [lindex $::tko::dialog::grabstack end]}
            }
        }
        if {$::tko::dialog eq {toplevel}} {
            wm withdraw $tko(.)
        } else {
            place forget $tko(.)
        }
    }
    set _tko(result) $returnvalue
    set _tko(wait) 1
    return
}

#-------------------------------------------------------------------------------
 
## Centers the dialog with respect to another widget or the screen as a whole.
#
# \param widget If given center dialog on topo of this widget.
::oo::define ::tko::dialog method center {{widget {}}} {
    update idletasks

    set w [winfo width $tko(.)]
    set h [winfo height $tko(.)]
    set sh [winfo screenheight $tko(.)]     ;# display screen's height/width
    set sw [winfo screenwidth $tko(.)]

    # User can request it centered with respect to root by passing in '{}'
    if { $widget == "" } {
        set reqX [expr {($sw-$w)/2}]
        set reqY [expr {($sh-$h)/2}]
    } else {
        set wfudge 5      ;# wm width fudge factor
        set hfudge 20     ;# wm height fudge factor
        set widgetW [winfo width $widget]
        set widgetH [winfo height $widget]
        set reqX [expr {[winfo rootx $widget]+($widgetW-($widgetW/2))-($w/2)}]
        set reqY [expr {[winfo rooty $widget]+($widgetH-($widgetH/2))-($h/2)}]

        # Adjust for errors - if too long or too tall
        if { ($reqX+$w+$wfudge) > $sw } { set reqX [expr {$sw-$w-$wfudge}] }
        if { $reqX < $wfudge } { set reqX $wfudge }
        if { ($reqY+$h+$hfudge) > $sh } { set reqY [expr {$sh-$h-$hfudge}] }
        if { $reqY < $hfudge } { set reqY $hfudge }
    } 
    wm geometry $tko(.) +$reqX+$reqY
}

#-------------------------------------------------------------------------------

# vim: set ts=4 sw=4 sts=4 et :
