1
# ------------------------------------------------------------------------------
3
# This file is part of Unifix BWidget Toolkit
4
# ------------------------------------------------------------------------------
7
# ------------------------------------------------------------------------------
9
namespace eval MessageDlg {
10
Widget::define MessageDlg messagedlg Dialog
12
Widget::tkinclude MessageDlg message .frame.msg \
13
remove [list -cursor -highlightthickness \
14
-highlightbackground -highlightcolor \
15
-relief -borderwidth -takefocus -textvariable \
17
rename [list -text -message] \
18
initialize [list -aspect 800 -anchor c -justify center]
20
Widget::bwinclude MessageDlg Dialog :cmd \
21
remove [list -modal -image -bitmap -side -anchor -separator \
22
-homogeneous -padx -pady -spacing]
24
Widget::declare MessageDlg {
25
{-icon Enum info 0 {none error info question warning}}
26
{-type Enum user 0 {abortretryignore ok okcancel \
27
retrycancel yesno yesnocancel user}}
28
{-buttons String "" 0}
29
{-buttonwidth String 0 0}
32
Widget::addmap MessageDlg "" tkMBox {
33
-parent {} -message {} -default {} -title {}
38
# ------------------------------------------------------------------------------
39
# Command MessageDlg::create
40
# ------------------------------------------------------------------------------
41
proc MessageDlg::create { path args } {
44
array set maps [list MessageDlg {} :cmd {} .frame.msg {} tkMBox {}]
45
array set maps [Widget::parseArgs MessageDlg $args]
46
Widget::initFromODB MessageDlg "$path#Message" $maps(MessageDlg)
48
array set dialogArgs $maps(:cmd)
50
set type [Widget::cget "$path#Message" -type]
51
set icon [Widget::cget "$path#Message" -icon]
52
set width [Widget::cget "$path#Message" -buttonwidth]
57
abortretryignore {set lbut {abort retry ignore}}
58
ok {set lbut {ok}; set defb 0 }
59
okcancel {set lbut {ok cancel}; set defb 0; set canb 1}
60
retrycancel {set lbut {retry cancel}; set defb 0; set canb 1}
61
yesno {set lbut {yes no}; set defb 0; set canb 1}
62
yesnocancel {set lbut {yes no cancel}; set defb 0; set canb 2}
63
user {set lbut [Widget::cget "$path#Message" -buttons]}
66
# If the user didn't specify a default button, use our type-specific
67
# default, adding its flag/value to the "user" settings and to the tkMBox
69
if { ![info exists dialogArgs(-default)] } {
70
lappend maps(:cmd) -default $defb
71
lappend maps(tkMBox) -default $defb
73
if { ![info exists dialogArgs(-cancel)] } {
74
lappend maps(:cmd) -cancel $canb
77
# Same with title as with default
78
if { ![info exists dialogArgs(-title)] } {
79
set frame [frame $path -class MessageDlg]
80
set title [option get $frame "${icon}Title" MessageDlg]
85
lappend maps(:cmd) -title $title
86
lappend maps(tkMBox) -title $title
89
# Create the "user" type dialog
90
if { $type == "user" } {
91
if { $icon != "none" } {
92
set image [Bitmap::get $icon]
96
eval [list Dialog::create $path] $maps(:cmd) \
97
[list -image $image -modal local -side bottom -anchor c]
99
Dialog::add $path -text $but -name $but -width $width
101
set frame [Dialog::getframe $path]
103
eval [list message $frame.msg] $maps(.frame.msg) \
104
[list -relief flat -borderwidth 0 -highlightthickness 0 \
106
pack $frame.msg -side left -padx 3m -pady 1m -fill x -expand yes
108
set res [Dialog::draw $path]
111
# Do some translation of args into tk_messageBox syntax, then create
113
array set tkMBoxArgs $maps(tkMBox)
114
set tkMBoxArgs(-default) [lindex $lbut $tkMBoxArgs(-default)]
115
if { ![string equal $icon "none"] } {
116
set tkMBoxArgs(-icon) $icon
118
if { [info exists tkMBoxArgs(-parent)] } {
119
if { ![winfo exists $tkMBoxArgs(-parent)] } {
120
unset tkMBoxArgs(-parent)
123
set tkMBoxArgs(-type) $type
124
set res [eval [list tk_messageBox] [array get tkMBoxArgs]]
125
set res [lsearch $lbut $res]
127
Widget::destroy "$path#Message"