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 / dialog.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  10.2 KB  |  325 lines
  1. # ------------------------------------------------------------------------------
  2. #  dialog.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. #  $Id: dialog.tcl,v 1.8 2000/06/15 00:45:15 kuchler Exp $
  5. # ------------------------------------------------------------------------------
  6. #  Index of commands:
  7. #     - Dialog::create
  8. #     - Dialog::configure
  9. #     - Dialog::cget
  10. #     - Dialog::getframe
  11. #     - Dialog::add
  12. #     - Dialog::itemconfigure
  13. #     - Dialog::itemcget
  14. #     - Dialog::invoke
  15. #     - Dialog::setfocus
  16. #     - Dialog::enddialog
  17. #     - Dialog::draw
  18. #     - Dialog::withdraw
  19. #     - Dialog::_destroy
  20. # ------------------------------------------------------------------------------
  21.  
  22. namespace eval Dialog {
  23.     ButtonBox::use
  24.  
  25.     Widget::bwinclude Dialog ButtonBox .bbox \
  26.         remove     {-orient} \
  27.         initialize {-spacing 10 -padx 10}
  28.  
  29.     Widget::declare Dialog {
  30.         {-title       String     ""       0}
  31.     {-geometry    String     ""       0}
  32.         {-modal       Enum       local    0 {none local global}}
  33.         {-bitmap      TkResource ""       1 label}
  34.         {-image       TkResource ""       1 label}
  35.         {-separator   Boolean    0        1}
  36.         {-cancel      Int        -1       0 "%d >= -1"}
  37.         {-parent      String     ""       0}
  38.         {-side        Enum       bottom   1 {bottom left top right}}
  39.         {-anchor      Enum       c        1 {n e w s c}}
  40.     {-class       String     Dialog   1}
  41.     }
  42.  
  43.     Widget::addmap Dialog "" :cmd   {-background {}}
  44.     Widget::addmap Dialog "" .frame {-background {}}
  45.  
  46.     proc ::Dialog { path args } { return [eval Dialog::create $path $args] }
  47.     proc use {} {}
  48.  
  49.     bind BwDialog <Destroy> {Dialog::enddialog %W -1; Dialog::_destroy %W}
  50.  
  51.     variable _widget
  52. }
  53.  
  54.  
  55. # ------------------------------------------------------------------------------
  56. #  Command Dialog::create
  57. # ------------------------------------------------------------------------------
  58. proc Dialog::create { path args } {
  59.     global   tcl_platform
  60.     variable _widget
  61.  
  62.     array set maps [list Dialog {} .bbox {}]
  63.     array set maps [Widget::parseArgs Dialog $args]
  64.  
  65.     # Check to see if the -class flag was specified
  66.     set dialogClass "Dialog"
  67.     array set dialogArgs $maps(Dialog)
  68.     if { [info exists dialogArgs(-class)] } {
  69.     set dialogClass $dialogArgs(-class)
  70.     }
  71.  
  72.     if { [string equal $tcl_platform(platform) "unix"] } {
  73.     set re raised
  74.     set bd 1
  75.     } else {
  76.     set re flat
  77.     set bd 0
  78.     }
  79.     toplevel $path -relief $re -borderwidth $bd -class $dialogClass
  80.  
  81.     Widget::initFromODB Dialog $path $maps(Dialog)
  82.  
  83.     bindtags $path [list $path BwDialog all]
  84.     wm overrideredirect $path 1
  85.     wm title $path [Widget::cget $path -title]
  86.     set parent [Widget::cget $path -parent]
  87.     if { ![winfo exists $parent] } {
  88.         set parent [winfo parent $path]
  89.     }
  90.     wm transient $path [winfo toplevel $parent]
  91.     wm withdraw $path
  92.  
  93.     set side [Widget::cget $path -side]
  94.     if { ![string compare $side "left"] || ![string compare $side "right"] } {
  95.         set orient vertical
  96.     } else {
  97.         set orient horizontal
  98.     }
  99.  
  100.     set bbox  [eval ButtonBox::create $path.bbox $maps(.bbox) -orient $orient]
  101.     set frame [frame $path.frame -relief flat -borderwidth 0]
  102.     set bg [Widget::cget $path -background]
  103.     $path configure -background $bg
  104.     $frame configure -background $bg
  105.     if { [set bitmap [Widget::getoption $path -image]] != "" } {
  106.         set label [label $path.label -image $bitmap -background $bg]
  107.     } elseif { [set bitmap [Widget::getoption $path -bitmap]] != "" } {
  108.         set label [label $path.label -bitmap $bitmap -background $bg]
  109.     }
  110.     if { [Widget::getoption $path -separator] } {
  111.                 Separator::create $path.sep -orient $orient -background $bg
  112.     }
  113.     set _widget($path,realized) 0
  114.     set _widget($path,nbut)     0
  115.  
  116.     bind $path <Escape>  "ButtonBox::invoke $path.bbox [Widget::getoption $path -cancel]"
  117.     bind $path <Return>  "ButtonBox::invoke $path.bbox default"
  118.  
  119.     rename $path ::$path:cmd
  120.     proc ::$path { cmd args } "return \[eval Dialog::\$cmd $path \$args\]"
  121.  
  122.     return $path
  123. }
  124.  
  125.  
  126. # ------------------------------------------------------------------------------
  127. #  Command Dialog::configure
  128. # ------------------------------------------------------------------------------
  129. proc Dialog::configure { path args } {
  130.     set res [Widget::configure $path $args]
  131.  
  132.     if { [Widget::hasChanged $path -title title] } {
  133.         wm title $path $title
  134.     }
  135.     if { [Widget::hasChanged $path -background bg] } {
  136.         if { [winfo exists $path.label] } {
  137.             $path.label configure -background $bg
  138.         }
  139.         if { [winfo exists $path.sep] } {
  140.             Separator::configure $path.sep -background $bg
  141.         }
  142.     }
  143.     return $res
  144. }
  145.  
  146.  
  147. # ------------------------------------------------------------------------------
  148. #  Command Dialog::cget
  149. # ------------------------------------------------------------------------------
  150. proc Dialog::cget { path option } {
  151.     return [Widget::cget $path $option]
  152. }
  153.  
  154.  
  155. # ------------------------------------------------------------------------------
  156. #  Command Dialog::getframe
  157. # ------------------------------------------------------------------------------
  158. proc Dialog::getframe { path } {
  159.     return $path.frame
  160. }
  161.  
  162.  
  163. # ------------------------------------------------------------------------------
  164. #  Command Dialog::add
  165. # ------------------------------------------------------------------------------
  166. proc Dialog::add { path args } {
  167.     variable _widget
  168.  
  169.     set res [eval ButtonBox::add $path.bbox \
  170.                  -command [list "Dialog::enddialog $path $_widget($path,nbut)"] $args]
  171.     incr _widget($path,nbut)
  172.     return $res
  173. }
  174.  
  175.  
  176. # ------------------------------------------------------------------------------
  177. #  Command Dialog::itemconfigure
  178. # ------------------------------------------------------------------------------
  179. proc Dialog::itemconfigure { path index args } {
  180.     return [eval ButtonBox::itemconfigure $path.bbox $index $args]
  181. }
  182.  
  183.  
  184. # ------------------------------------------------------------------------------
  185. #  Command Dialog::itemcget
  186. # ------------------------------------------------------------------------------
  187. proc Dialog::itemcget { path index option } {
  188.     return [ButtonBox::itemcget $path.bbox $index $option]
  189. }
  190.  
  191.  
  192. # ------------------------------------------------------------------------------
  193. #  Command Dialog::invoke
  194. # ------------------------------------------------------------------------------
  195. proc Dialog::invoke { path index } {
  196.     ButtonBox::invoke $path.bbox $index
  197. }
  198.  
  199.  
  200. # ------------------------------------------------------------------------------
  201. #  Command Dialog::setfocus
  202. # ------------------------------------------------------------------------------
  203. proc Dialog::setfocus { path index } {
  204.     ButtonBox::setfocus $path.bbox $index
  205. }
  206.  
  207.  
  208. # ------------------------------------------------------------------------------
  209. #  Command Dialog::enddialog
  210. # ------------------------------------------------------------------------------
  211. proc Dialog::enddialog { path result } {
  212.     variable _widget
  213.  
  214.     set _widget($path,result) $result
  215. }
  216.  
  217.  
  218. # ------------------------------------------------------------------------------
  219. #  Command Dialog::draw
  220. # ------------------------------------------------------------------------------
  221. proc Dialog::draw { path {focus ""} {overrideredirect 0} {geometry ""}} {
  222.     variable _widget
  223.  
  224.     set parent [Widget::getoption $path -parent]
  225.     if { !$_widget($path,realized) } {
  226.         set _widget($path,realized) 1
  227.         if { [llength [winfo children $path.bbox]] } {
  228.             set side [Widget::getoption $path -side]
  229.             if { ![string compare $side "left"] || ![string compare $side "right"] } {
  230.                 set pad  -padx
  231.                 set fill y
  232.             } else {
  233.                 set pad  -pady
  234.                 set fill x
  235.             }
  236.             pack $path.bbox -side $side -anchor [Widget::getoption $path -anchor] -padx 1m -pady 1m
  237.             if { [winfo exists $path.sep] } {
  238.                 pack $path.sep -side $side -fill $fill $pad 2m
  239.             }
  240.         }
  241.         if { [winfo exists $path.label] } {
  242.             pack $path.label -side left -anchor n -padx 3m -pady 3m
  243.         }
  244.         pack $path.frame -padx 1m -pady 1m -fill both -expand yes
  245.     }
  246.  
  247.     set geom [Widget::getMegawidgetOption $path -geometry]
  248.     if { $geom != "" } {
  249.     wm geometry $path $geom
  250.     }
  251.  
  252.     if { [string equal $geometry ""] && ($geom == "") } {
  253.         if { [winfo exists $parent] } {
  254.             BWidget::place $path 0 0 center $parent
  255.         } else {
  256.             BWidget::place $path 0 0 center
  257.         }
  258.     } else {
  259.     if { $geom != "" } {
  260.         wm geometry $path $geom
  261.     } else {
  262.         wm geometry $path $geometry
  263.     }
  264.     }
  265.     update idletasks
  266.     wm overrideredirect $path $overrideredirect
  267.     wm deiconify $path
  268.  
  269.     tkwait visibility $path
  270.     BWidget::focus set $path
  271.     if { [winfo exists $focus] } {
  272.         focus -force $focus
  273.     } else {
  274.         ButtonBox::setfocus $path.bbox default
  275.     }
  276.  
  277.     if { [set grab [Widget::cget $path -modal]] != "none" } {
  278.         BWidget::grab $grab $path
  279.         if {[info exists _widget($path,result)]} { 
  280.             unset _widget($path,result)
  281.         }
  282.         tkwait variable Dialog::_widget($path,result)
  283.         if { [info exists _widget($path,result)] } {
  284.             set res $_widget($path,result)
  285.             unset _widget($path,result)
  286.         } else {
  287.             set res -1
  288.         }
  289.         withdraw $path
  290.         return $res
  291.     }
  292.     return ""
  293. }
  294.  
  295.  
  296. # ------------------------------------------------------------------------------
  297. #  Command Dialog::withdraw
  298. # ------------------------------------------------------------------------------
  299. proc Dialog::withdraw { path } {
  300.     BWidget::grab release $path
  301.     BWidget::focus release $path
  302.     if { [winfo exists $path] } {
  303.         wm withdraw $path
  304.     }
  305. }
  306.  
  307.  
  308. # ------------------------------------------------------------------------------
  309. #  Command Dialog::_destroy
  310. # ------------------------------------------------------------------------------
  311. proc Dialog::_destroy { path } {
  312.     variable _widget
  313.  
  314.     BWidget::grab  release $path
  315.     BWidget::focus release $path
  316.     if {[info exists _widget($path,result)]} {
  317.         unset _widget($path,result)
  318.     }
  319.     unset _widget($path,realized)
  320.     unset _widget($path,nbut)
  321.  
  322.     Widget::destroy $path
  323.     rename $path {}
  324. }
  325.