commits for 7.5.0 pre-release tarball

[xconq] / tcltk / BWidget / messagedlg.tcl

diff --git a/tcltk/BWidget/messagedlg.tcl b/tcltk/BWidget/messagedlg.tcl
new file mode 100644 (file)
index 0000000..f0dc7b8
--- /dev/null
+++ b/tcltk/BWidget/messagedlg.tcl
@@ -0,0 +1,129 @@
+# ------------------------------------------------------------------------------
+#  messagedlg.tcl
+#  This file is part of Unifix BWidget Toolkit
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#     - MessageDlg::create
+# ------------------------------------------------------------------------------
+
+namespace eval MessageDlg {
+    Widget::define MessageDlg messagedlg Dialog
+
+    Widget::tkinclude MessageDlg message .frame.msg \
+           remove [list -cursor -highlightthickness            \
+               -highlightbackground -highlightcolor            \
+               -relief -borderwidth -takefocus -textvariable   \
+               ] \
+           rename [list -text -message]                        \
+           initialize [list -aspect 800 -anchor c -justify center]
+
+    Widget::bwinclude MessageDlg Dialog :cmd \
+           remove [list -modal -image -bitmap -side -anchor -separator \
+               -homogeneous -padx -pady -spacing]
+
+    Widget::declare MessageDlg {
+        {-icon       Enum   info 0 {none error info question warning}}
+        {-type       Enum   user 0 {abortretryignore ok okcancel \
+               retrycancel yesno yesnocancel user}}
+        {-buttons     String "" 0}
+        {-buttonwidth String 0  0}
+    }
+
+    Widget::addmap MessageDlg "" tkMBox {
+       -parent {} -message {} -default {} -title {}
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command MessageDlg::create
+# ------------------------------------------------------------------------------
+proc MessageDlg::create { path args } {
+    global tcl_platform
+
+    array set maps [list MessageDlg {} :cmd {} .frame.msg {} tkMBox {}]
+    array set maps [Widget::parseArgs MessageDlg $args]
+    Widget::initFromODB MessageDlg "$path#Message" $maps(MessageDlg)
+
+    array set dialogArgs $maps(:cmd)
+
+    set type  [Widget::cget "$path#Message" -type]
+    set icon  [Widget::cget "$path#Message" -icon]
+    set width [Widget::cget "$path#Message" -buttonwidth]
+
+    set defb  -1
+    set canb  -1
+    switch -- $type {
+        abortretryignore {set lbut {abort retry ignore}}
+        ok               {set lbut {ok}; set defb 0 }
+        okcancel         {set lbut {ok cancel}; set defb 0; set canb 1}
+        retrycancel      {set lbut {retry cancel}; set defb 0; set canb 1}
+        yesno            {set lbut {yes no}; set defb 0; set canb 1}
+        yesnocancel      {set lbut {yes no cancel}; set defb 0; set canb 2}
+        user             {set lbut [Widget::cget "$path#Message" -buttons]}
+    }
+
+    # If the user didn't specify a default button, use our type-specific
+    # default, adding its flag/value to the "user" settings and to the tkMBox
+    # settings
+    if { ![info exists dialogArgs(-default)] } {
+       lappend maps(:cmd) -default $defb
+       lappend maps(tkMBox) -default $defb
+    }
+    if { ![info exists dialogArgs(-cancel)] } {
+        lappend maps(:cmd) -cancel $canb
+    }
+
+    # Same with title as with default
+    if { ![info exists dialogArgs(-title)] } {
+        set frame [frame $path -class MessageDlg]
+        set title [option get $frame "${icon}Title" MessageDlg]
+        destroy $frame
+        if { $title == "" } {
+            set title "Message"
+        }
+       lappend maps(:cmd) -title $title
+       lappend maps(tkMBox) -title $title
+    }
+
+    # Create the "user" type dialog
+    if { $type == "user" } {
+        if { $icon != "none" } {
+            set image [Bitmap::get $icon]
+        } else {
+            set image ""
+        }
+        eval [list Dialog::create $path] $maps(:cmd) \
+           [list -image $image -modal local -side bottom -anchor c]
+        foreach but $lbut {
+            Dialog::add $path -text $but -name $but -width $width
+        }
+        set frame [Dialog::getframe $path]
+
+        eval [list message $frame.msg] $maps(.frame.msg) \
+           [list -relief flat -borderwidth 0 -highlightthickness 0 \
+                -textvariable ""]
+        pack  $frame.msg -side left -padx 3m -pady 1m -fill x -expand yes
+
+        set res [Dialog::draw $path]
+       destroy $path
+    } else {
+       # Do some translation of args into tk_messageBox syntax, then create
+       # the tk_messageBox
+       array set tkMBoxArgs $maps(tkMBox)
+       set tkMBoxArgs(-default) [lindex $lbut $tkMBoxArgs(-default)]
+       if { ![string equal $icon "none"] } {
+           set tkMBoxArgs(-icon) $icon
+       }
+       if { [info exists tkMBoxArgs(-parent)] } {
+           if { ![winfo exists $tkMBoxArgs(-parent)] } {
+               unset tkMBoxArgs(-parent)
+           }
+       }
+       set tkMBoxArgs(-type) $type
+       set res [eval [list tk_messageBox] [array get tkMBoxArgs]]
+       set res [lsearch $lbut $res]
+    }
+    Widget::destroy "$path#Message"
+    return $res
+}