1# ------------------------------------------------------------------------------ 2# messagedlg.tcl 3# This file is part of Unifix BWidget Toolkit 4# $Id: messagedlg.tcl,v 1.91 2009/09/06 21:23:06 oberdorfer Exp $ 5# ------------------------------------------------------------------------------ 6# Index of commands: 7# - MessageDlg::create 8# ------------------------------------------------------------------------------ 9 10namespace eval MessageDlg { 11 Widget::define MessageDlg messagedlg Dialog 12 13 if {[BWidget::using ttk]} { 14 Widget::tkinclude MessageDlg ttk::label .frame.msg \ 15 rename { 16 -text -message 17 } initialize { 18 -aspect 800 -anchor c -justify center 19 } 20 } else { 21 Widget::tkinclude MessageDlg message .frame.msg \ 22 remove [list -cursor -highlightthickness \ 23 -highlightbackground -highlightcolor \ 24 -relief -borderwidth -takefocus -textvariable \ 25 ] \ 26 rename [list -text -message] \ 27 initialize [list -aspect 800 -anchor c -justify center] 28 } 29 30 Widget::bwinclude MessageDlg Dialog :cmd \ 31 remove [list -modal -image -bitmap -side -anchor -separator \ 32 -homogeneous -padx -pady -spacing] 33 34 Widget::declare MessageDlg { 35 {-icon Enum info 0 {none error info question warning}} 36 {-type Enum user 0 {abortretryignore ok okcancel \ 37 retrycancel yesno yesnocancel user}} 38 {-buttons String "" 0} 39 {-buttonwidth String 0 0} 40 } 41 42 Widget::addmap MessageDlg "" tkMBox { 43 -parent {} -message {} -default {} -title {} 44 } 45} 46 47 48# ------------------------------------------------------------------------------ 49# Command MessageDlg::create 50# ------------------------------------------------------------------------------ 51proc MessageDlg::create { path args } { 52 global tcl_platform 53 54 array set maps [list MessageDlg {} :cmd {} .frame.msg {} tkMBox {}] 55 array set maps [Widget::parseArgs MessageDlg $args] 56 Widget::initFromODB MessageDlg "$path#Message" $maps(MessageDlg) 57 58 array set dialogArgs $maps(:cmd) 59 60 set type [Widget::cget "$path#Message" -type] 61 set icon [Widget::cget "$path#Message" -icon] 62 set width [Widget::cget "$path#Message" -buttonwidth] 63 64 set defb -1 65 set canb -1 66 switch -- $type { 67 abortretryignore {set lbut {abort retry ignore}; set defb 0} 68 ok {set lbut {ok}; set defb 0 } 69 okcancel {set lbut {ok cancel}; set defb 0; set canb 1} 70 retrycancel {set lbut {retry cancel}; set defb 0; set canb 1} 71 yesno {set lbut {yes no}; set defb 0; set canb 1} 72 yesnocancel {set lbut {yes no cancel}; set defb 0; set canb 2} 73 user {set lbut [Widget::cget "$path#Message" -buttons]} 74 } 75 76 # If the user didn't specify a default button, use our type-specific 77 # default, adding its flag/value to the "user" settings and to the tkMBox 78 # settings 79 if { ![info exists dialogArgs(-default)] } { 80 lappend maps(:cmd) -default $defb 81 lappend maps(tkMBox) -default $defb 82 } 83 if { ![info exists dialogArgs(-cancel)] } { 84 lappend maps(:cmd) -cancel $canb 85 } 86 87 # Same with title as with default 88 if { ![info exists dialogArgs(-title)] } { 89 set frame [frame $path -class MessageDlg] 90 set title [option get $frame "${icon}Title" MessageDlg] 91 destroy $frame 92 if { $title == "" } { 93 set title "Message" 94 } 95 lappend maps(:cmd) -title $title 96 lappend maps(tkMBox) -title $title 97 } 98 99 # Create the "user" type dialog 100 if { $type == "user" } { 101 if { $icon != "none" } { 102 set image [Bitmap::get $icon] 103 } else { 104 set image "" 105 } 106 eval [list Dialog::create $path] $maps(:cmd) \ 107 [list -image $image -modal local -side bottom -anchor e] 108 foreach but $lbut { 109 Dialog::add $path -text $but -name $but -width $width 110 } 111 set frame [Dialog::getframe $path] 112 113 eval [list message $frame.msg] $maps(.frame.msg) \ 114 [list -relief flat -borderwidth 0 -highlightthickness 0 \ 115 -textvariable ""] 116 pack $frame.msg -side left -padx 3m -pady 1m -fill x -expand yes 117 118 set res [Dialog::draw $path] 119 destroy $path 120 } else { 121 # Do some translation of args into tk_messageBox syntax, then create 122 # the tk_messageBox 123 array set tkMBoxArgs $maps(tkMBox) 124 set tkMBoxArgs(-default) [lindex $lbut $tkMBoxArgs(-default)] 125 if { ![string equal $icon "none"] } { 126 set tkMBoxArgs(-icon) $icon 127 } 128 if {[info exists tkMBoxArgs(-parent)] 129 && ![winfo exists $tkMBoxArgs(-parent)]} { 130 unset tkMBoxArgs(-parent) 131 } 132 set tkMBoxArgs(-type) $type 133 set res [eval [list tk_messageBox] [array get tkMBoxArgs]] 134 set res [lsearch $lbut $res] 135 } 136 Widget::destroy "$path#Message" 137 return $res 138} 139