I often come across little gems like at [A little value dialog] and [Another little value dialog], but they are often unfinished or rough at the edges. And, often as not, I come across them while searching for something a bit more industrial-strength for use in an application I am building. Hence, here is my version of '''tk_getString''': a dialogue much like [tk_messageBox] to obtain a text string from the user, but significantly more flexible than what I have seen. Also, it uses the [Ttk] widgets, so it requires '''Tk 8.5''' to work. If this is an issue it shouldn't take much to remove all the 8.5 stuff... The completed concept combines from several sources, including two little functions in Delphi ('''inputbox''' and '''inputquery''') and what I have seen used in existing software, and adapted to the Tk way of doing things. **Documentation** This is not actually marked-up for [groff]... I could do that, if wanted or needed, but for now this will do. ====== NAME tk_getString - pops up a window and gets a textual response from the user SYNOPSIS tk_getString ?option value ...? DESCRIPTION This procedure creates and displays a modal dialog window with an application-specified prompt message and input-validation and help command hooks. After the window displays, tk_getString waits for the user to type-in/modify/accept a response and select one of the buttons. The buttons are "Ok", "Cancel", and, if the -helpcommand option is given, "Help". Only the ok and cancel buttons cause the dialog to terminate. The result of the command is a list, where the first element is the button selected to terminate the dialog, and the second element is the input string. The following option-value pairs are supported: -default STRING Gives the default value to return. When the message dialog is first displayed, the entire text will be selected. -fractionx FLOAT -fractiony FLOAT These control how the window is to be centered in its parent. FLOAT is a floating point value in the range 0 to 1, inclusive. 0 represents the top or left edge, and 1 represents the bottom or right. The default is just a little above center. -height INTEGER Specifies the height of the pop-down listbox, in rows. This option is only meaningful if the -values option is used. Defaults to 10. See the ttk::combobox -height option for more information. -helpcommand SCRIPT -helpcmd SCRIPT -hcmd SCRIPT The command script to evaluate if the user presses the help button. See ttk::button -command for more information. -invalidcommand SCRIPT -invalidcmd SCRIPT -icmd SCRIPT The command script to evaluate whenever the -validatecommand option script returns false (or zero). See ttk::entry validation for more information. -parent WINDOW Makes WINDOW the logical parent of the dialog window. The dialog is displayed on top of the parent window. If no parent window is given, the dialog is centered on the screen. -prompt TEXT The message to display to the user. The message does NOT have word-wrap or any other fancy formatting. You can, however, make multiple lines by embedding newlines in the TEXT. -show TEXT If this opiton is specified, then the true contents of the entry are not displayed in the dialog window. Instead, each character in the dialog's entry's value will be displayed as the first character in the TEXT, such as "*" or a bullet. This is useful, for example, if the dialog is to be used to enter a password. If characters in the the dialog's entry are selected and copied elsewhere, the information copied will be what is displayed, not the true contents of the entry. See the ttk::entry -show option for more information. -state STATE One of "normal" or "readonly". In the readonly state, the value may not be edited directly, and the user can only select one of the -values from the drop-down listbox. In the normal state, the text field is directly editable. This option is only useful if the -values option is used. -title TEXT The TEXT to give the window manager as the title and iconname for the dialog window. -validatecommand SCRIPT -validatecmd SCRIPT -vcmd SCRIPT The command script to evaluate every time an edit is made to the text by the user (but not by changing the -variable programmatically). If set to the empty string (the default), validation is disabled. The script must return a boolean value. See ttk::entry "key" validation for more information. -values LIST If specified, the entry widget is exchanged for a combobox widget, but only if the -show option is not used. Specifies the list of values to display in the drop-down listbox. See ttk::combobox for more information. Also see the -height option. -variable VARNAME Specifies the name of a global variable whose value is linked to the dialog's entry widget's contents. Whenever the variable changes value, the dialog's contents are updated, and vice versa. If the variable did not exist before calling the dialog, it does afterwards. -width INTEGER Specifies an integer value indicating the desired width of the dialog's entry widget, in average-size characters of the widget's font. See the ttk::entry -width option for more information. NOTES This dialog uses the ttk::entry widget, which has some differences from the standard Tk entry widget. See ttk::entry "Differences from Tk entry widget validation". BINDINGS Besides all the ttk::entry default bindings, the following are also bound to the dialog. * The Return and KP_Enter keys are bound to the ok button. * The Escape key and closing the window are bound to the cancel button. * The F1 and Help keys are bound to the help button (if any). BUGS The -height option doesn't seem to be properly handled. (But that is a ttk::combobox issue.) I forgot about the taskbar... SEE ALSO ttk::button ttk::combobox ttk::entry ttk::label ... TODO Make the prompt take some form of fancy formatting (like HTML or something?) Copyright 2011 Michael Thomas Greer ====== **The Code** The script is a bit longer than that found in the other examples, but at just over 200 lines it is hopefully well-enough organized for you all. ====== # # Copyright (c) 2011 by Michael Thomas Greer # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # package require Tk 8.5 #----------------------------------------------------------------------------- namespace eval ::tk::tk_getString:: { proc refocus args { # Used to force the modal dialog to have focus after # evaluating any of the user command option scripts. # (Since the script could do just about anything...) focus -force [lindex $args 0] } } #----------------------------------------------------------------------------- proc ::tk::tk_getString args { if {[llength $args] % 2} { return -code error {wrong # args: must be "tk_getString ?option value ...?"} } array set options { #-default {this must not exist unless specified by the user} -fractionx .50 -fractiony .425 -height 10 -helpcommand {} -invalidcommand {} -parent {} -prompt {} -show {} -state normal #-title {this must not exist unless specified by the user} -validatecommand {} -values {} -variable {} -width 0 } array set options $args foreach {name abbreviations} { -helpcommand {-hcmd -helpcmd} -invalidcommand {-icmd -invalidcmd} -validatecommand {-vcmd -validatecmd} } { foreach abbreviation $abbreviations { if {[info exists options($abbreviation)]} { set options($name) $options($abbreviation) } } } # Validate options ......................................................... if {($options(-parent) ne {}) && ![winfo exists $options(-parent)]} { error "bad window path name \"$options(-parent)\"" } foreach opt {fractionx fractiony} { set v $options(-$opt) if {![string is double -strict $v] || ($v < 0) || ($v > 1)} { error "expected floating-point $opt in \[0.0, 1.0\] but got \"$v\"" } } foreach opt {height width} { if {![string is integer -strict $options(-$opt)]} { error "expected integer $opt but got \"$options(-$opt)\"" } } if {$options(-state) ni {normal readonly}} { error "bad state \"$options(-state)\": must be normal or readonly" } if {![info exist options(-title)]} { # we must have a -title if {$options(-parent) ne {}} \ then { set options(-title) [wm title $options(-parent)] } \ else { set options(-title) [wm title .] } } if {$options(-show) ne {}} { # -show beats -values set options(-values) {} } # Create and populate the dialog window .................................... set w [string map {.. .} $options(-parent).[clock microseconds]] toplevel $w -relief flat -class TkGetStringDialog variable ::tk::$w.buttonpressed variable ::tk::$w.refocus {} trace add variable ::tk::$w.refocus write [list ::tk::tk_getString::refocus $w.entry] wm title $w $options(-title) wm iconname $w $options(-title) wm protocol $w WM_DELETE_WINDOW [list set ::tk::$w.buttonpressed cancel] wm transient $w [winfo toplevel [winfo parent $w]] set prev_focus [focus -displayof $w] set prev_grab [grab current $w] # (The text variable) if {$options(-variable) eq {}} \ then { set varname ::$w.value; set $varname {} } \ else { set varname $options(-variable) } upvar #0 $varname var if {![info exists var]} { set var {} } if {[info exists options(-default)]} { set var $options(-default) } # (The prompt message, if any) if {$options(-prompt) ne {}} { ttk::label $w.prompt -text $options(-prompt) pack $w.prompt -side top -expand yes -fill x } # (Command options) foreach cmd {-helpcommand -invalidcommand -validatecommand} { if {[llength $options($cmd)] != 0} { set options($cmd) "set ::tk::$w.refocus \[ $options($cmd) \]" } } # (Entry widget) if {[llength $options(-values)]} \ then { ttk::combobox $w.entry \ -height $options(-height) \ -invalidcommand $options(-invalidcommand) \ -state $options(-state) \ -textvariable $varname \ -validate [expr {[llength $options(-validatecommand)] ? {key} : {none}}] \ -validatecommand $options(-validatecommand) \ -values $options(-values) \ -width $options(-width) } \ else { ttk::entry $w.entry \ -invalidcommand $options(-invalidcommand) \ -show $options(-show) \ -textvariable $varname \ -validate [expr {[llength $options(-validatecommand)] ? {key} : {none}}] \ -validatecommand $options(-validatecommand) \ -width $options(-width) } if {$var ne {}} { $w.entry selection range 0 end } pack $w.entry -side top -padx 10 -pady 5 -expand yes -fill x # (Buttons) ttk::frame $w.buttons ttk::button $w.buttons.ok -text Ok -command [list set ::tk::$w.buttonpressed ok] ttk::button $w.buttons.cancel -text Cancel -command [list set ::tk::$w.buttonpressed cancel] ttk::button $w.buttons.help -text Help -command $options(-helpcommand) pack $w.buttons.ok -side left -expand yes -fill x pack $w.buttons.cancel -side left -expand yes -fill x if {[llength $options(-helpcommand)] != 0} { pack $w.buttons.help -side left -expand yes -fill x } pack $w.buttons -expand yes -fill x # (Global bindings) bind $w [list set ::tk::$w.buttonpressed ok] bind $w [list set ::tk::$w.buttonpressed ok] bind $w [list set ::tk::$w.buttonpressed cancel] bind $w [list set ::tk::$w.buttonpressed cancel] bind $w $options(-helpcommand) bind $w $options(-helpcommand) # Properly position it on the display ...................................... # See "Total Window Geometry" http://wiki.tcl.tk/11291 wm withdraw $w update idletasks focus -force $w.entry if {$options(-parent) eq {}} \ then { # (Position on the user's screen/vroot) lassign [split [winfo geometry $w] +] foo dtop dleft set dw [expr {[winfo rootx $w] - $dleft}] set dh [expr {[winfo rooty $w] - $dtop }] set x [expr {round( ([winfo vrootwidth $w] - [winfo reqwidth $w] - $dw) * $options(-fractionx) )}] set y [expr {round( ([winfo vrootheight $w] - [winfo reqheight $w] - $dh) * $options(-fractiony) )}] } \ else { # (Position on the parent widget) set p $options(-parent) set x [expr {round( (([winfo width $p] - [winfo reqwidth $w]) * $options(-fractionx)) + [winfo x $p] )}] set y [expr {round( (([winfo height $p] - [winfo reqheight $w]) * $options(-fractiony)) + [winfo y $p] )}] } incr x -[winfo vrootx $w] incr y -[winfo vrooty $w] wm geometry $w +$x+$y wm deiconify $w wm resizable $w 0 0 grab $w # Run the dialog ........................................................... tkwait variable ::tk::$w.buttonpressed set result [list [set ::tk::$w.buttonpressed] $var] # Clean up ................................................................. grab release $w destroy $w focus -force $prev_focus if {$prev_grab ne {}} { grab $prev_grab } update idletasks unset ::tk::$w.refocus unset ::tk::$w.buttonpressed if {$options(-variable) eq {}} { unset var } return $result } namespace eval ::tk:: { namespace export tk_getString } namespace import ::tk::tk_getString ====== **Examples** Here are some simple examples to get you going. You'll need [wish] with a [console] attached to try them. ****Ask for a password**** lassign [tk_getString -prompt {Enter your password} -show \u25CF -hcmd {tk_messageBox -message {No, not really} }] ok password if {$ok eq {ok}} { puts "Woah! You used \"$password\" as your password? Wow...." } ****Choose from a list**** lassign [tk_getString \ -prompt {What is your favorite number?} \ -vcmd { string is double %P } \ -icmd { tk_messageBox -message {That's not a number!} } \ -values {0 1 2 3 3.14159265 5 7 13 17 42 74 99}] \ ok n if {($ok eq {ok}) && ($n ne {})} { puts "Amazing! My favorite number is [expr {$n + 1}]!" } ****Default value**** tk_getString -title {Adventure} -prompt {What would you like to do?} -default {Look around} \ -values {{Look around} {Go North} {Go East} {Give up}} **Legal Stuff** All this is licensed under the usual Tcl license, so have fun! ---- Well, that's all I can think of at the moment. The code has been pretty thoroughly tested. Outside of the braces bug (which I don't know how to fix), it works solidly for me on Win XP. I do not have access to a Mac, and Kubuntu update trashed my Linux installation, so it will be a while before I can replace it... If you find any bugs or have any questions, please post! ---- I fixed the nested braces bug... But I forgot about the Windows taskbar and the -fractiony option! :-( ---- See also: * [A little value dialog] * [Another little value dialog] <>GUI|Dialog