source: trunk/BWidget-1.2.1/messagedlg.tcl @ 931

Last change on this file since 931 was 931, checked in by toby, 11 years ago

include rest of files

File size: 4.2 KB
Line 
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    Dialog::use
11
12    Widget::tkinclude MessageDlg message .frame.msg \
13        remove     {-cursor -highlightthickness -highlightbackground -highlightcolor \
14                        -relief -borderwidth -takefocus -textvariable} \
15        rename     {-text -message} \
16        initialize {-aspect 800 -anchor c -justify center}
17
18    Widget::bwinclude MessageDlg Dialog "" \
19        remove {-modal -image -bitmap -side -anchor -separator \
20                    -homogeneous -padx -pady -spacing}
21
22    Widget::declare MessageDlg {
23        {-icon       Enum   info 0 {none error info question warning}}
24        {-type       Enum   user 0 {abortretryignore ok okcancel retrycancel yesno yesnocancel user}}
25        {-buttons    String ""   0}
26    }
27
28    proc ::MessageDlg { path args } { return [eval MessageDlg::create $path $args] }
29    proc use { } {}
30}
31
32
33# ------------------------------------------------------------------------------
34#  Command MessageDlg::create
35# ------------------------------------------------------------------------------
36proc MessageDlg::create { path args } {
37    global tcl_platform
38
39    Widget::init MessageDlg "$path#Message" $args
40    set type  [Widget::getoption "$path#Message" -type]
41    set title [Widget::getoption "$path#Message" -title]
42    set icon  [Widget::getoption "$path#Message" -icon]
43    set defb  -1
44    set canb  -1
45    switch -- $type {
46        abortretryignore {set lbut {abort retry ignore}}
47        ok               {set lbut {ok}; set defb 0 }
48        okcancel         {set lbut {ok cancel}; set defb 0; set canb 1}
49        retrycancel      {set lbut {retry cancel}; set defb 0; set canb 1}
50        yesno            {set lbut {yes no}; set defb 0; set canb 1}
51        yesnocancel      {set lbut {yes no cancel}; set defb 0; set canb 2}
52        user             {set lbut [Widget::getoption "$path#Message" -buttons]}
53    }
54    if { [Widget::getoption "$path#Message" -default] == -1 } {
55        Widget::setoption "$path#Message" -default $defb
56    }
57    if { [Widget::getoption "$path#Message" -cancel] == -1 } {
58        Widget::setoption "$path#Message" -cancel $canb
59    }
60    if { $title == "" } {
61        set frame [frame $path -class MessageDlg]
62        set title [option get $frame "${icon}Title" MessageDlg]
63        destroy $frame
64        if { $title == "" } {
65            set title "Message"
66        }
67    }
68    Widget::setoption "$path#Message" -title $title
69    if { $tcl_platform(platform) == "unix" || $type == "user" } {
70        if { $icon != "none" } {
71            set image [Bitmap::get $icon]
72        } else {
73            set image ""
74        }
75        eval Dialog::create $path [Widget::subcget "$path#Message" ""] \
76            -image $image -modal local -side bottom -anchor c
77        set idbut 0
78        foreach but $lbut {
79            Dialog::add $path -text $but -name $but
80        }
81        set frame [Dialog::getframe $path]
82
83        eval message $frame.msg [Widget::subcget "$path#Message" .frame.msg] \
84            -relief flat -borderwidth 0 -highlightthickness 0 -textvariable {""}
85        pack  $frame.msg -side left -padx 3m -pady 1m -fill x -expand yes
86
87        set res [Dialog::draw $path]
88    } else {
89        set parent [Widget::getoption "$path#Message" -parent]
90        set def    [lindex $lbut [Widget::getoption "$path#Message" -default]]
91        set opt    [list \
92                        -message [Widget::getoption "$path#Message" -message] \
93                        -type    $type  \
94                        -title   $title]
95        if { [winfo exists $parent] } {
96           lappend opt -parent $parent
97        }
98        if { $def != "" } {
99           lappend opt -default $def
100        }
101        if { $icon != "none" } {
102           lappend opt -icon $icon
103        }
104        set res [eval tk_messageBox $opt]
105        set res [lsearch $lbut $res]
106    }
107    Widget::destroy "$path#Message"
108    destroy $path
109
110    return $res
111}
Note: See TracBrowser for help on using the repository browser.