Updated 2014-10-10 07:04:22 by Duoas

A modal dialog is a dialog that prevents users to do other things unless the dialog is finished. Modal dialogue is still common nowadays even there are arguments in usability community that most modal dialog are actually results of failures of usable designs.

Although tk ships with demo program of how to make a modal dialog, which, is in fact an ordinary window with local grab, there still are other implementation of dialogs. For example, both bwidget and tklib offer a "Dialog" widget.

Other ways to achieve modality: busy, tk busy (built in to 8.6), Byzi, tkbusy

Arjen Markus I have combined the advice by Marty Backe and Erik Leunissen into a small recipe for creating modal dialog(ue)s.

I felt a recipe was needed as the proper implementation requires:

both of which are somewhat obscure commands.

GWM I have a [Simple Modal Page] method useful in a Wizard.

I have tested the code on UNIX (Sun Solaris with CDE window manager, Tcl/Tk 8.3.1) and Windows NT, Tcl/Tk 8.3.4). I have not paid any attention to the layout of the two windows :-)
 #
 # Create a button in the . window that displays a message box when pressed
 #
 button .hi -text Hi -command {tk_messageBox -message "Hi"}
 pack .hi
 #
 # Create a second window which acts as modal dialogue:
 # - make sure it is on top (first wait for the . window!)
 # - grab the display (locally)
 # - wait for the dialogue to disappear
 #
 # Note: the implementation is fairly rigorous. Leaving out
 #       some of the [wm] commands may work on a particular platform,
 #       but this way it works well on both UNIX and Windows)
 #       Leaving out [wm transient] gives a different appearance    pack .button
 #       on Windows.
 #
 tkwait visibility .

 toplevel .f
 button .f.b -text Close -command {destroy .f} 
 pack .f.b
 grab .f
 wm transient .f .
 wm protocol .f WM_DELETE_WINDOW {grab release .f; destroy .f}
 raise .f
 tkwait window .f 

Here's one [Martin Bachem] posted to comp.lang.tcl:
    #!/bin/sh \
    # exec wish "$0" "$@"
    proc foreground_win { w } {
       wm withdraw $w
       wm deiconify $w
    }

    proc modal_window { } {
       set w .dialog_window     
       catch { destroy $w }
       toplevel $w

       bind $ <ButtonPress> { raise $w }
       wm title $w "Dialog Window"
       # place all widgets here ...


       catch {tkwait visibility $w}
       catch {grab $w}

       foreground_win $w
    }

    button .button -text "Show Modal Dialog" -command modal_window
    grid .button
    foreground_win .

The extent to which one finds the commands grab' and wm' obscure, will probably depend a lot of ones perspective. Those familiar with programming GUI's will not find them so strange, while some people are quite proficient in this area and have no trouble to use these commands to their specific needs. As for modal dialogs, the BWidgets code for `Dialog' can serve as an example of how the details of a dialog can be controlled.

Erik Leunissen.

AM Of course, you are right :-) For me, the wm transient command was the most obscure, and I had never used grab before. I did not mean it as a comment on the commands themselves, rather that using these commands requires some care - especially in combination, they may produce different effects in different settings.

aricb 2010-09-24

Jeff Hobbs mentions on comp.lang.tcl that the tklib widget::dialog package is a good option for creating modal dialogs. To my knowledge, the only documentation for this package is in the source code itself, but it's clear and contains enough detail (including examples) to get you up and running.

Duoas 2014-10-10 Here's a lightweight proc I coded up recently.
  #-----------------------------------------------------------------------------
  # Show.Modal win ?-onclose script? ?-destroy bool?
  #
  # Displays $win as a modal dialog. 
  #
  # If -destroy is true then $win is destroyed when the dialog is closed. 
  # Otherwise the caller must do it. 
  #
  # If an -onclose script is provided, it is executed if the user terminates the 
  # dialog through the window manager (such as clicking on the [X] button on the 
  # window decoration), and the result of that script is returned. The default 
  # script does nothing and returns an empty string. 
  #
  # Otherwise, the dialog terminates when the global ::Modal.Result is set to a 
  # value. 
  #
  # This proc doesn't play nice if you try to have more than one modal dialog 
  # active at a time. (Don't do that anyway!)
  #
  # Examples:
  #   -onclose {return cancel}    -->    Show.Modal returns the word 'cancel'
  #   -onclose {list 1 2 3}       -->    Show.Modal returns the list {1 2 3}
  #   -onclose {set ::x zap!}     -->    (variations on a theme)
  #
  proc Show.Modal {win args} {
    set ::Modal.Result {}
    array set options [list -onclose {} -destroy 0 {*}$args]
    wm transient $win .
    wm protocol $win WM_DELETE_WINDOW [list catch $options(-onclose) ::Modal.Result]
    set x [expr {([winfo width  .] - [winfo reqwidth  $win]) / 2 + [winfo rootx .]}]
    set y [expr {([winfo height .] - [winfo reqheight $win]) / 2 + [winfo rooty .]}]
    wm geometry $win +$x+$y
    raise $win
    focus $win
    grab $win
    tkwait variable ::Modal.Result
    grab release $win
    if {$options(-destroy)} {destroy $win}
    return ${::Modal.Result}
  }

And the obligatory example of how to put it to use. Try to terminate the dialog all possible ways to see which of the two responses it generates.

  • via WM
  • press Enter
  • press Esc
  • click a button
  • Tab to a button and press Space
  proc Hello user {
    set ok  {set ::Modal.Result {Yeah!}}
    set foo {set ::Modal.Result {Fooey. That's no response.}}
    toplevel .hello
    ttk::label  .hello.message -text "Hello $user!"
    ttk::button .hello.hi -text Hi!       -command $ok
    ttk::button .hello.no -text Whatever. -command $foo
    grid .hello.message -row 0 -column 0 -columnspan 2 -sticky we
    grid .hello.hi      -row 1 -column 0               -sticky we
    grid .hello.no      -row 1 -column 1               -sticky we
    focus .hello.hi
    bind .hello <Return> $ok
    bind .hello <Escape> $foo
    set result [Show.Modal .hello -destroy 1 -onclose $foo]
    tk_messageBox -message $result -type ok
  }
  
  ttk::label .clickme -text {Click Me} -anchor center
  pack propagate . false
  pack .clickme -expand yes -fill both
  bind . <Button-1> {Hello world}