The following code demonstrates how to create a simple custom dialogue window using Tcl/Tk. This is an embellishment to the code presented in Practical Programming in Tcl and Tk - 4th Edition, chapter 39, pages 602-609.

Book Errata for 4th Edition: beedub.com/book/4th/Errata1.html Note: For performance reasons, preference is given to map and unmap windows instead of destroying them. Reference chapter 44, page 661 that captures the tricks used here.

This module can run independently

package require Tk

proc Dialog_Create {top title width height xScreenPos yScreenPos args} {
    global dialog
    set winexist [winfo exists $top]

    if [ winfo exists $top ] {
        switch -- [wm state $top] {
            normal -
            zoomed {
                raise $top
            }
            withdrawn -
            iconic {
                wm deiconify $top
                catch {wm geometry $top $::dialog(geo,$top)}
            }
        }
        return 0
    } else {
        eval {toplevel $top} $args
        wm title $top $title
        puts "Dialog_Create Window Geometry:  [wm geometry $top]"
        wm resizable $top 1 0
        return 1
    }
}

proc Dialog_Wait {top varName { focus {} }} {
    upvar $varName var

    bind $top <Destroy> [list set $varName 0]

    if { [ string length $focus ] == 0 } {
        set focus $top
    }
    set old [focus -displayof $top]
    focus $focus

    catch {tkwait visibility $top}
    catch {grab $top}

    tkwait variable $varName
    catch {grab release $top}
    focus $old
}

proc Dialog_Dismiss {top} {
    global dialog
    catch {
        set ::dialog(geo,$top) [list [wm geometry $top]]
        wm withdraw $top
    }
}

proc verifyEntry {} {
    global signIn

    puts "Entered validateEntry procedure"
    puts "String $::signIn(username)\nLength:  [string length $::signIn(username)]"
    puts "String $::signIn(password)\nLength:  [string length $::signIn(password)]"

    if { [string length $::signIn(username)] > 0 && [string length $::signIn(password)] > 0} {
        puts "Entry validated"
        set ::signIn(ok) 1
    } else {
        puts "Entry error:  Zero length entries.\nSignIn(ok) = $::signIn(ok)"
    }
}

proc validateEntry {} {
    puts "Entered proc validateEntry "
    puts "Exiting proc validateEntry "
}

proc Dialog_Manager { username password width height xpos ypos } {
    global signIn

    set f .prompt
    if { [Dialog_Create $f "Sign In" $width $height $xpos $ypos -borderwidth 10 ] } {

        labelframe $f.userframe -text $username
        label $f.userframe.msguser -text $username
        entry $f.userframe.username -textvariable ::signIn(username); #-validate validateEntry
        pack $f.userframe.username -side top -padx 4 -expand yes -fill x
        pack $f.userframe.msguser -side left -padx 4 -anchor w

        labelframe $f.passframe -text $password
        label $f.passframe.msgpass -text $password
        entry $f.passframe.password -show "*" -textvariable ::signIn(password); #-validate validateEntry
        pack $f.passframe.password -side top -padx 4 -expand yes -fill x
        pack $f.passframe.msgpass -side top -anchor w

        set b [frame $f.buttons]
        button $b.signin -text "Sign In" -command { verifyEntry }
        button $b.cancel -text Cancel -command {set ::signIn(ok) 0}

        pack $b.signin -side left -ipadx 5 -padx 20 -pady 5
        pack $b.cancel -side right -ipadx 5 -padx 20 -pady 5

        pack $f.buttons -side bottom -expand yes -padx 5 -pady 5
        pack $f.userframe $f.passframe -side top -expand no -fill x -anchor n -padx 5 -pady 5

        update idletasks
        puts "Dialog_Manager AFTER packing."
        puts "Dialog_Manager is $f Mapped? (0=No, 1=Yes):  [winfo ismapped ${f}]"
        puts "Dialog Manager - winfo reqwidth:  [winfo reqwidth $f]"
        puts "Dialog_Manager - winfo reqheight:  [winfo reqheight $f]"

        wm minsize $f $width [winfo reqheight $f]

        bind $f.userframe.username <Return> { verifyEntry }
        bind $f.userframe.username <Control-c> {set ::signIn(ok) 0 ; break }

        bind $f.passframe.password <Return> { verifyEntryEntry }
        bind $f.passframe.password <Control-c> {set ::signIn(ok) 0 ; break }
    }

    set ::signIn(ok) 0
    set ::signIn(username) ""
    set ::signIn(password) ""
    set ::signIn(result) ""

    bell -displayof .prompt -nice

    Dialog_Wait $f ::signIn(ok) $f.userframe.username
    Dialog_Dismiss $f
    if { $::signIn(ok) } {
        return [list $::signIn(username) $::signIn(password)]
    } else {
        return {}
    }
}

proc signIn {} {
    Dialog_Manager "Username" "Password" "300" "250" "50" "50"
    puts "UserName = $::signIn(username)"
    puts "PassWord = $::signIn(password)"
}

label .lblWelcome -text "Welcome to TclTk.ca\n\nSimple Custom Dialogue Demonstration"

frame .btnFrame
button .btnFrame.btnSignIn -text "Launch" -command { signIn }
button .btnFrame.btnExit -text "Exit/Cancel" -command exit
pack .btnFrame.btnSignIn -side left -ipadx 5 -padx 20
pack .btnFrame.btnExit -side right -ipadx 5 -padx 20

pack .btnFrame -side bottom -expand no -pady 10
pack .lblWelcome -side top -pady 10 -expand yes -fill x

wm geometry . 400x155+100+100
wm title . "Tcl/Tk Custom Dialogue"

This code will be refined in future posts to add real verification