diff options
Diffstat (limited to 'lib/dialogues/my_tk_messageBox.tcl')
-rw-r--r-- | lib/dialogues/my_tk_messageBox.tcl | 303 |
1 files changed, 303 insertions, 0 deletions
diff --git a/lib/dialogues/my_tk_messageBox.tcl b/lib/dialogues/my_tk_messageBox.tcl new file mode 100644 index 0000000..0698e9e --- /dev/null +++ b/lib/dialogues/my_tk_messageBox.tcl @@ -0,0 +1,303 @@ +#!/usr/bin/tclsh +# Part of MCU 8051 IDE ( http://mcu8051ide.sf.net ) + +############################################################################ +# Copyright (C) 2009, 2010, 2011, 2012 by Martin Ošmera # +# martin.osmera@gmail.com # +# # +# This program is free software; you can redistribute it and#or modify # +# it under the terms of the GNU General Public License as published by # +# the Free Software Foundation; either version 2 of the License, or # +# (at your option) any later version. # +# # +# This program is distributed in the hope that it will be useful, # +# but WITHOUT ANY WARRANTY; without even the implied warranty of # +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # +# GNU General Public License for more details. # +# # +# You should have received a copy of the GNU General Public License # +# along with this program; if not, write to the # +# Free Software Foundation, Inc., # +# 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # +############################################################################ + +# >>> File inclusion guard +if { ! [ info exists _MY_TK_MESSAGEBOX_TCL ] } { +set _MY_TK_MESSAGEBOX_TCL _ +# <<< File inclusion guard + +# -------------------------------------------------------------------------- +# DESCRIPTION +# Replacement for Tk's tk_messageBox. Usage is the same as tk_messageBox, +# except for one thing, this one supports also "-icon ok". +# -------------------------------------------------------------------------- + +## This namespace implements dialog itself, but does not contain the + # "tk_messageBox" function to invoke it. This function is defined onwards, but + # still in this file. +namespace eval my_tk_messageBox { + ## Namespace variables + variable return_value {} ;# String: Dialog return value (e.g. "abort") + variable dialog ;# Widget: Dialog toplevel window + variable count 0 ;# Int: Counter of object instances + # Buttons available in the dialog + variable available_buttons { + abort retry ignore + ok cancel yes + no + } + # Icons for available buttons + variable button_icons { + button_cancel reload forward + ok cancel ok + no + } + + ## Invoke the dialog + # @parm Int arg_default - Number of default button (0..2) + # @parm String arg_icon - Dialog icon (one of values mentioned in variable button_icons) + # @parm String arg_message - Message to display to the user + # @parm Widget arg_parent - GUI parent + # @parm String arg_title - Dialog title + # @parm String arg_type - Name of big icon displyed beside the message (one of {error info question warning ok}) + # @return String - Dialog return value, name of pressed button + proc create {arg_default arg_icon arg_message arg_parent arg_title arg_type} { + variable return_value {} ;# String: Dialog return value (e.g. "abort") + variable button_icons ;# Icons for available buttons + variable available_buttons ;# Buttons available in the dialog + variable dialog ;# Widget: Dialog toplevel window + variable count ;# Int: Counter of object instances + + set dialog [toplevel .my_tk_messageBox_${count}] + set buttons [list] + incr count + + # Translate icon name + switch -- $arg_icon { + {error} { + set iconphoto {cancel} + set arg_icon {messagebox_critical} + } + {info} { + set iconphoto {info} + set arg_icon {messagebox_info} + } + {question} { + set iconphoto {help} + set arg_icon {help} + } + {warning} { + set iconphoto {status_unknown} + set arg_icon {messagebox_warning} + } + {ok} { + set iconphoto {ok} + set arg_icon {button_ok} + } + } + + # Determinate list of buttons + switch -- $arg_type { + {abortretryignore} { + set buttons [list abort retry ignore] + } + {ok} { + set buttons [list ok] + } + {okcancel} { + set buttons [list ok cancel] + } + {retrycancel} { + set buttons [list retry cancel] + } + {yesno} { + set buttons [list yes no] + } + {yesnocancel} { + set buttons [list yes no cancel] + } + } + + # Adjuts argument "default" + if {$arg_default == {}} { + set arg_default [lindex $buttons 0] + } elseif {[lsearch -ascii -exact $buttons $arg_default] == -1} { + error "my_tk_messageBox: Invalid value of agument -default, must be one of: $buttons" + } + + # Create top frame (dialog icon and text of the message) + set top_frame [frame $dialog.top] + pack [label $top_frame.img -image ::ICONS::32::$arg_icon] -side left -padx 5 + pack [label $top_frame.txt -text $arg_message -wraplength 300 -justify left] -side left -fill both -padx 5 + + # Create bottom bar with dialog buttons + set bottom_frame [frame $dialog.bottom] + foreach button $buttons { + set button_icon [lindex $button_icons [ \ + lsearch $available_buttons $button \ + ]] + + set text [string toupper [string index $button 0]] + append text [string range $button 1 end] + + pack [ttk::button $bottom_frame.button_${button} \ + -text [mc $text] -compound left \ + -image ::ICONS::16::$button_icon \ + -command "::my_tk_messageBox::button_press $button" \ + ] -side left -padx 2 + bind $bottom_frame.button_${button} <Return> "::my_tk_messageBox::button_press $button" + bind $bottom_frame.button_${button} <KP_Enter> "::my_tk_messageBox::button_press $button" + bind $bottom_frame.button_${button} <Escape> " + grab release $dialog + destroy $dialog + set ::my_tk_messageBox::return_value {} + " + } + + # Pack window frames + pack $top_frame -expand 1 -pady 10 -padx 5 + pack $bottom_frame -padx 5 -pady 10 + + # Window manager options -- modal window + wm iconphoto $dialog ::ICONS::16::$iconphoto + wm title $dialog $arg_title + wm state $dialog normal + focus -force $bottom_frame.button_${arg_default} + if {$arg_parent != {}} { + wm transient $dialog $arg_parent + } + wm protocol $dialog WM_DELETE_WINDOW " + grab release $dialog + destroy $dialog + set ::my_tk_messageBox::return_value {} + " + update + catch { + grab $dialog + } + + # Wait for user response + tkwait window $dialog + + # Destroy dialog and return name of pressed button + catch { + grab release $dialog + destroy $dialog + } + return $return_value + } + + ## Handles button press + # @parm String value - Name of pressed button + # @return void + proc button_press {value} { + variable return_value ;# String: Dialog return value (e.g. "abort")g + variable dialog ;# Widget: Dialog toplevel window + + grab release $dialog + destroy $dialog + set return_value $value + } + + ## Load needed images from the specified directory + # @parm String directory - Source directory + # @return void + proc load_images {directory} { + foreach subdir {16x16 32x32} ns {16 32} icons { + {cancel info help status_unknown ok button_cancel reload forward no} + {messagebox_critical messagebox_info help messagebox_warning button_ok} + } \ + { + foreach icon $icons { + set filename [file join $directory {../icons} $subdir "${icon}.png"] + + if {[catch { + image create photo ::ICONS::${ns}::${icon} -format png -file $filename + } result]} then { + puts stderr {} + puts -nonewline stderr $result + image create photo ::ICONS::${ns}::${icon} + } + } + } + } +} + +## Replacement for Tk's command "tk_messageBox" + # Usage is the same as "tk_messageBox" ... +proc my_tk_messageBox args { + set length [llength $args] + if {$length % 2} { + error "my_tk_messageBox: Odd number of arguments given" + } + + set arg_default {} + set arg_icon {info} + set arg_message {} + set arg_parent {} + set arg_title {} + set arg_type {} + + for {set i 0; set j 1} {$i < $length} {incr i 2; incr j 2} { + set attr [lindex $args $i] + set val [lindex $args $j] + + switch -- $attr { + {-default} { + set arg_default $val + } + {-icon} { + if {[lsearch -ascii -exact {error info question warning ok} $val] == -1} { + error "my_tk_messageBox: Invalid message box icon: $val" + } + set arg_icon $val + } + {-message} { + set arg_message $val + } + {-parent} { + if {![winfo exists $val]} { + error "my_tk_messageBox: Window $val does not exist." + } + set arg_parent $val + } + {-title} { + set arg_title $val + } + {-type} { + if {[lsearch -ascii -exact {abortretryignore ok okcancel retrycancel yesno yesnocancel} $val] == -1} { + error "my_tk_messageBox: Invalid message box type: $val" + } + set arg_type $val + } + default { + error "my_tk_messageBox: Unknown argument: $attr" + } + } + } + + if {![string length $arg_message]} { + error "my_tk_messageBox: No message box text specified" + } + if {![string length $arg_title]} { + if {![string length $arg_icon]} { + set arg_title {Message} + } else { + set arg_title [string toupper [string index $arg_icon 0]] + append arg_title [string range $arg_icon 1 end] + } + } + if {![string length $arg_type]} { + set arg_type {ok} + } + + return [my_tk_messageBox::create $arg_default $arg_icon $arg_message $arg_parent $arg_title $arg_type] +} + +# Replace Tk's command "tk_messageBox" +rename tk_messageBox old_tk_messageBox +rename my_tk_messageBox tk_messageBox + +# >>> File inclusion guard +} +# <<< File inclusion guard |