1# ------------------------------------------------------------------------------
2#  messagedlg.tcl
3#  This file is part of Unifix BWidget Toolkit
4# ------------------------------------------------------------------------------
5#  Index of commands:
6#     - MessageDlg::create
7# ------------------------------------------------------------------------------
8
9namespace eval MessageDlg {
10    Widget::define MessageDlg messagedlg Dialog
11
12    Widget::tkinclude MessageDlg message .frame.msg \
13	    remove [list -cursor -highlightthickness		\
14		-highlightbackground -highlightcolor		\
15		-relief -borderwidth -takefocus -textvariable	\
16		] \
17	    rename [list -text -message]			\
18	    initialize [list -aspect 800 -anchor c -justify center]
19
20    Widget::bwinclude MessageDlg Dialog :cmd \
21	    remove [list -modal -image -bitmap -side -anchor -separator \
22		-homogeneous -padx -pady -spacing]
23
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}
30    }
31
32    Widget::addmap MessageDlg "" tkMBox {
33	-parent {} -message {} -default {} -title {}
34    }
35}
36
37
38# ------------------------------------------------------------------------------
39#  Command MessageDlg::create
40# ------------------------------------------------------------------------------
41proc MessageDlg::create { path args } {
42    global tcl_platform
43
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)
47
48    array set dialogArgs $maps(:cmd)
49
50    set type  [Widget::cget "$path#Message" -type]
51    set icon  [Widget::cget "$path#Message" -icon]
52    set width [Widget::cget "$path#Message" -buttonwidth]
53
54    set defb  -1
55    set canb  -1
56    switch -- $type {
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]}
64    }
65
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
68    # settings
69    if { ![info exists dialogArgs(-default)] } {
70	lappend maps(:cmd) -default $defb
71	lappend maps(tkMBox) -default $defb
72    }
73    if { ![info exists dialogArgs(-cancel)] } {
74        lappend maps(:cmd) -cancel $canb
75    }
76
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]
81        destroy $frame
82        if { $title == "" } {
83            set title "Message"
84        }
85	lappend maps(:cmd) -title $title
86	lappend maps(tkMBox) -title $title
87    }
88
89    # Create the "user" type dialog
90    if { $type == "user" } {
91        if { $icon != "none" } {
92            set image [Bitmap::get $icon]
93        } else {
94            set image ""
95        }
96        eval [list Dialog::create $path] $maps(:cmd) \
97	    [list -image $image -modal local -side bottom -anchor c]
98        foreach but $lbut {
99            Dialog::add $path -text $but -name $but -width $width
100        }
101        set frame [Dialog::getframe $path]
102
103        eval [list message $frame.msg] $maps(.frame.msg) \
104	    [list -relief flat -borderwidth 0 -highlightthickness 0 \
105		 -textvariable ""]
106        pack  $frame.msg -side left -padx 3m -pady 1m -fill x -expand yes
107
108        set res [Dialog::draw $path]
109	destroy $path
110    } else {
111	# Do some translation of args into tk_messageBox syntax, then create
112	# the tk_messageBox
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
117	}
118	if { [info exists tkMBoxArgs(-parent)] } {
119	    if { ![winfo exists $tkMBoxArgs(-parent)] } {
120		unset tkMBoxArgs(-parent)
121	    }
122	}
123	set tkMBoxArgs(-type) $type
124	set res [eval [list tk_messageBox] [array get tkMBoxArgs]]
125	set res [lsearch $lbut $res]
126    }
127    Widget::destroy "$path#Message"
128    return $res
129}
130