An option dialog

AF 24-06-2003


Classic (without Ttk)

 proc tk_getOption {w var title text initial args} {
    global $var
    variable ::tk::Priv
    catch {unset $var}
    catch {destroy $w}
    set focus [focus]
    set grab [grab current .]

    toplevel $w -bd 1 -relief raised -class TkSDialog
    wm title $w $title
    wm iconname $w $title
    wm protocol $w WM_DELETE_WINDOW {set ::tk::Priv(button) 0}
    wm transient $w [winfo toplevel [winfo parent $w]]

    set menu [eval tk_optionMenu $w.menu $var $args]
    $w.menu configure -width 25
    button $w.ok -bd 1 -width 5 -text Ok -default active -command {set ::tk::Priv(button) 1}
    button $w.cancel -bd 1 -text Cancel -command {set ::tk::Priv(button) 0}
    label $w.label -text $text

    if {$text != ""} {grid $w.label -columnspan 2 -sticky ew -padx 3 -pady 3}
    grid $w.menu -columnspan 2 -sticky ew -padx 3 -pady 3
    grid $w.ok $w.cancel -padx 3 -pady 3
    grid rowconfigure $w 2 -weight 1
    grid columnconfigure $w {0 1} -uniform 1 -weight 1

    bind $w <Return> {set ::tk::Priv(button) 1}
    bind $w <Destroy> {set ::tk::Priv(button) 0}
    bind $w <Escape> {set ::tk::Priv(button) 0}

    if {$initial != ""} {set $var $initial}
    wm withdraw $w
    update idletasks
    set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 - [winfo vrootx $w]}]
    set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 - [winfo vrooty $w]}]
    wm geom $w +$x+$y
    wm deiconify $w
    grab $w

    tkwait variable ::tk::Priv(button)
    bind $w <Destroy> {}
    grab release $w
    destroy $w
    focus -force $focus
    if {$grab != ""} {grab $grab}
    update idletasks
    return $::tk::Priv(button)
 }

With Ttk

proc tk_getOption {w var title text initial args} {
   global $var
   variable ::tk::Priv
   catch {unset $var}
   catch {destroy $w}
   set focus [focus]
   set grab [grab current .]

   toplevel $w -class TkSDialog
   wm title $w $title
   wm iconname $w $title
   wm protocol $w WM_DELETE_WINDOW {set ::tk::Priv(button) 0}
   wm transient $w [winfo toplevel [winfo parent $w]]
   puts [winfo toplevel [winfo parent $w]]
   set f [ttk::frame $w.xf]

   set combo [eval ttk::combobox $f.combo -textvariable $var -values [list $args] -state readonly]
   $f.combo configure -width 25
   ttk::button $f.ok -width 5 -text Ok -default active -command {set ::tk::Priv(button) 1}
   ttk::button $f.cancel -text Cancel -command {set ::tk::Priv(button) 0}
   ttk::label $f.label -text $text

   if {$text != ""} {
     grid $f.label -columnspan 2 -sticky ew -padx 3 -pady 3
   }
   grid $f.combo -columnspan 2 -sticky ew -padx 3 -pady 3
   grid $f.ok $f.cancel -padx 3 -pady 3
   grid rowconfigure $f 2 -weight 1
   grid columnconfigure $f {0 1} -uniform 1 -weight 1
   pack $f -expand 1 -fill both
   bind $w <Return> {set ::tk::Priv(button) 1}
   bind $w <Destroy> {set ::tk::Priv(button) 0}
   bind $w <Escape> {set ::tk::Priv(button) 0}

   if {$initial != ""} {set $var $initial}
   wm withdraw $w
   update idletasks

   set parent [winfo toplevel [winfo parent $w]]
   set pw     [winfo reqwidth $parent]
   set ph     [winfo reqwidth $parent]

   set width  [winfo reqwidth $w]
   set height [winfo reqheight $w]
   if { $width < $pw && $height < $ph } {
     set x [expr { [winfo x $parent] + ( $pw - $width  ) / 2 }]
     set y [expr { [winfo y $parent] + ( $ph - $height ) / 2 }]
   } else {
     set x [expr { ( [winfo vrootwidth  $w] - $width  ) / 2 }]
     set y [expr { ( [winfo vrootheight $w] - $height ) / 2 }]
   }
   wm geometry $w +$x+$y
   wm deiconify $w
   grab $w

   tkwait variable ::tk::Priv(button)
   bind $w <Destroy> {}
   grab release $w
   destroy $w
   focus -force $focus
   if {$grab != ""} {grab $grab}
   update idletasks
   return $::tk::Priv(button)
}

Examples

  tk_getOption .opt result "Option Dialog" "Please choose an option" three one two three four five six
  tk_getOption .opt result "Option Dialog" {} "Choose an option" one two three four five six
  tk_getOption .opt result "Option Dialog" {} {} one two three four five six

if 0 {

Usage:

 tk_getOption w var title text prompt start args

w: toplevel name

var: global variable in which the result is stored

title: title of the toplevel

text: text for the prompt over the option menu, may be set to null if you do not wish for a static prompt

initial: set the initial value, this value does not have to be one of the options, and may be null

args: the values that will be selectable in the option menu }


Have you thought about adding this to tklib?


See also A not-so-little value dialog


Both Tk and ttk together

TWu - 2025-03-04 14:20:45

I combined both source codes into one. You can switch using the variable ::tk_getOption_Style
(empty stands for Tk, anything else for ttk, if it is available)
You may test it via the three example lines above. Have a look at the picture for a preview.
OptionDialog Tk and ttk

proc tk_getOption {w var title text initial args} {
        global $var
        variable ::tk::Priv
        catch {unset $var}
        catch {destroy $w}
        set focus [focus]
        set grab [grab current .]
        toplevel $w -class TkSDialog
        # Only available for newer Tcl/Tk!        Initialize if not yet done.
        if {(![package vsatisfies $::tk_patchLevel 8.5a6-])\
          ||(![info exists ::tk_getOption_Style])} {
                set ::tk_getOption_Style ""
        }
        if {[string length $::tk_getOption_Style]==0} {
                $w configure -bd 1 -relief raised
        } else {
                # Make sure ttk will be used!        (Older maybe use tile?)
                set ::tk_getOption_Style "::ttk::"
        }
        wm title $w $title
        wm iconname $w $title
        wm protocol $w WM_DELETE_WINDOW {set ::tk::Priv(button) 0}
        set parent [winfo toplevel [winfo parent $w]]
        # puts $parent
        wm transient $w $parent
        set f [${::tk_getOption_Style}frame $w.xf]
        ${::tk_getOption_Style}button $f.ok -width 5 -text Ok -default active -command {set ::tk::Priv(button) 1}
        ${::tk_getOption_Style}button $f.cancel -text Cancel -command {set ::tk::Priv(button) 0}
        if {[string length $::tk_getOption_Style]==0} {
                set combo [eval tk_optionMenu $f.combo $var $args]
                $f.ok configure -bd 1
                $f.cancel configure -bd 1
        } else {
                set combo [eval ${::tk_getOption_Style}combobox $f.combo -textvariable $var -values [list $args] -state readonly]
        }
        $f.combo configure -width 25
        if {[string length $text]>0} {
                ${::tk_getOption_Style}label $f.label -text $text
                grid $f.label -padx 3 -pady 3 -columnspan 2 -sticky ew
        }
        grid $f.combo -padx 3 -pady 3 -columnspan 2 -sticky ew
        grid $f.ok $f.cancel -padx 3 -pady 3
        grid rowconfigure $f 2 -weight 1
        grid columnconfigure $f {0 1} -weight 1 -uniform 1
        pack $f -expand 1 -fill both
        bind $w <Return> {set ::tk::Priv(button) 1}
        bind $w <Destroy> {set ::tk::Priv(button) 0}
        bind $w <Escape> {set ::tk::Priv(button) 0}
        if {[string length $initial]>0} {
                set $var $initial
        }
        wm withdraw $w
        update idletasks
        # Don't know where is the real difference?
        if {[string length $::tk_getOption_Style]==0} {
                set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 - [winfo vrootx $w]}]
                set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 - [winfo vrooty $w]}]
        } else {
                set pw [winfo reqwidth $parent]
                set ph [winfo reqheight $parent]
                set width [winfo reqwidth $w]
                set height [winfo reqheight $w]
                if {$width<$pw&&$height<$ph} {
                        set x [expr {[winfo x $parent]+($pw-$width)>>1}]
                        set y [expr {[winfo y $parent]+($ph-$height)>>1}]
                } else {
                        set x [expr {([winfo vrootwidth $w]-$width)>>1}]
                        set y [expr {([winfo vrootheight $w]-$height)>>1}]
                }
        }
        wm geometry $w +$x+$y
        wm deiconify $w
        grab $w
        tkwait variable ::tk::Priv(button)
        bind $w <Destroy> {}
        grab release $w
        destroy $w
        focus -force $focus
        if {$grab!=""} {
                grab $grab
        }
        update idletasks
        return $::tk::Priv(button)
}