home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 May / PCWorld_2002-05_cd.bin / Software / TemaCD / activetcltk / ActiveTcl8.3.4.1-8.win32-ix86.exe / ActiveTcl8.3.4.1-win32-ix86 / lib / bwidget1.3.0 / messagedlg.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  4.4 KB  |  131 lines
  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.     Dialog::use
  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.     }
  30.  
  31.     Widget::addmap MessageDlg "" tkMBox {
  32.     -parent {} -message {} -default {} -title {}
  33.     }
  34.  
  35.     proc ::MessageDlg { path args } { return [eval MessageDlg::create $path $args] }
  36.     proc use { } {}
  37. }
  38.  
  39.  
  40. # ------------------------------------------------------------------------------
  41. #  Command MessageDlg::create
  42. # ------------------------------------------------------------------------------
  43. proc MessageDlg::create { path args } {
  44.     global tcl_platform
  45.  
  46.     array set maps [list MessageDlg {} :cmd {} .frame.msg {} tkMBox {}]
  47.     array set maps [Widget::parseArgs MessageDlg $args]
  48.     Widget::initFromODB MessageDlg "$path#Message" $maps(MessageDlg)
  49.  
  50.     array set dialogArgs $maps(:cmd)
  51.  
  52.     set type  [Widget::cget "$path#Message" -type]
  53.     set icon  [Widget::cget "$path#Message" -icon]
  54.  
  55.     set defb  -1
  56.     set canb  -1
  57.     switch -- $type {
  58.         abortretryignore {set lbut {abort retry ignore}}
  59.         ok               {set lbut {ok}; set defb 0 }
  60.         okcancel         {set lbut {ok cancel}; set defb 0; set canb 1}
  61.         retrycancel      {set lbut {retry cancel}; set defb 0; set canb 1}
  62.         yesno            {set lbut {yes no}; set defb 0; set canb 1}
  63.         yesnocancel      {set lbut {yes no cancel}; set defb 0; set canb 2}
  64.         user             {set lbut [Widget::cget "$path#Message" -buttons]}
  65.     }
  66.  
  67.     # If the user didn't specify a default button, use our type-specific
  68.     # default, adding its flag/value to the "user" settings and to the tkMBox
  69.     # settings
  70.     if { ![info exists dialogArgs(-default)] } {
  71.     lappend maps(:cmd) -default $defb
  72.     lappend maps(tkMBox) -default $defb
  73.     }
  74.     if { ![info exists dialogArgs(-cancel)] } {
  75.         lappend maps(:cmd) -cancel $canb
  76.     }
  77.  
  78.     # Same with title as with default
  79.     if { ![info exists dialogArgs(-title)] } {
  80.         set frame [frame $path -class MessageDlg]
  81.         set title [option get $frame "${icon}Title" MessageDlg]
  82.         destroy $frame
  83.         if { $title == "" } {
  84.             set title "Message"
  85.         }
  86.     lappend maps(:cmd) -title $title
  87.     lappend maps(tkMBox) -title $title
  88.     }
  89.  
  90.     # Create the "user" type dialog
  91.     if { $type == "user" } {
  92.         if { $icon != "none" } {
  93.             set image [Bitmap::get $icon]
  94.         } else {
  95.             set image ""
  96.         }
  97.         eval Dialog::create $path $maps(:cmd) -image $image -modal local \
  98.         -side bottom -anchor c
  99.         foreach but $lbut {
  100.             Dialog::add $path -text $but -name $but
  101.         }
  102.         set frame [Dialog::getframe $path]
  103.  
  104.         eval message $frame.msg $maps(.frame.msg) \
  105.         -relief flat -borderwidth 0 -highlightthickness 0 \
  106.         -textvariable {{}}
  107.         pack  $frame.msg -side left -padx 3m -pady 1m -fill x -expand yes
  108.  
  109.         set res [Dialog::draw $path]
  110.     destroy $path
  111.     } else {
  112.     # Do some translation of args into tk_messageBox syntax, then create
  113.     # the tk_messageBox
  114.     array set tkMBoxArgs $maps(tkMBox)
  115.     set tkMBoxArgs(-default) [lindex $lbut $tkMBoxArgs(-default)]
  116.     if { ![string equal $icon "none"] } {
  117.         set tkMBoxArgs(-icon) $icon
  118.     }
  119.     if { [info exists tkMBoxArgs(-parent)] } {
  120.         if { ![winfo exists $tkMBoxArgs(-parent)] } {
  121.         unset tkMBoxArgs(-parent)
  122.         }
  123.     }
  124.     set tkMBoxArgs(-type) $type
  125.     set res [eval tk_messageBox [array get tkMBoxArgs]]
  126.     set res [lsearch $lbut $res]
  127.     }
  128.     Widget::destroy "$path#Message"
  129.     return $res
  130. }
  131.