← Back to branch summary

~ubuntu-branches/ubuntu/quantal/astk/quantal

« back to all changes in this revision

Viewing changes to ASTK_CLIENT/lib/BWidget-1.7.0/messagedlg.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Christophe Trophime
  • Date: 2010-04-25 16:43:13 UTC
  • Revision ID: james.westby@ubuntu.com-20100425164313-0s0wtsmbiewbdz53
Tags: upstream-1.8.0
Import upstream version 1.8.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
ASTK_CLIENT/lib/BWidget-1.7.0/messagedlg.tcl
 
1
# ------------------------------------------------------------------------------
 
2
#  messagedlg.tcl
 
3
#  This file is part of Unifix BWidget Toolkit
 
4
# ------------------------------------------------------------------------------
 
5
#  Index of commands:
 
6
#     - MessageDlg::create
 
7
# ------------------------------------------------------------------------------
 
8
 
 
9
namespace 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
# ------------------------------------------------------------------------------
 
41
proc 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
}