home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / BWidget-1.2 / dialog.tcl < prev    next >
Text File  |  2000-11-02  |  10KB  |  291 lines
  1. # ------------------------------------------------------------------------------
  2. #  dialog.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. #  $Id: dialog.tcl,v 1.1.1.1 1996/02/22 06:05:55 daniel 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.         {-modal       Enum       local    0 {none local global}}
  32.         {-bitmap      TkResource ""       1 label}
  33.         {-image       TkResource ""       1 label}
  34.         {-separator   Boolean    0        1}
  35.         {-cancel      Int        -1       0 {=-1 ""}}
  36.         {-parent      String     ""       0}
  37.         {-side        Enum       bottom   1 {bottom left top right}}
  38.         {-anchor      Enum       c        1 {n e w s c}}
  39.     }
  40.  
  41.     Widget::addmap Dialog "" :cmd   {-background {}}
  42.     Widget::addmap Dialog "" .frame {-background {}}
  43.  
  44.     proc ::Dialog { path args } { return [eval Dialog::create $path $args] }
  45.     proc use {} {}
  46.  
  47.     bind BwDialog <Destroy> {Dialog::enddialog %W -1; Dialog::_destroy %W}
  48.  
  49.     variable _widget
  50. }
  51.  
  52.  
  53. # ------------------------------------------------------------------------------
  54. #  Command Dialog::create
  55. # ------------------------------------------------------------------------------
  56. proc Dialog::create { path args } {
  57.     global   tcl_platform
  58.     variable _widget
  59.  
  60.     Widget::init Dialog $path $args
  61.     set bg [Widget::getoption $path -background]
  62.     if { ![string compare $tcl_platform(platform) "unix"] } {
  63.         toplevel $path -relief raised -borderwidth 1 -background $bg
  64.     } else {
  65.         toplevel $path -relief flat   -borderwidth 0 -background $bg
  66.     }
  67.     bindtags $path [list $path BwDialog all]
  68.     wm overrideredirect $path 1
  69.     wm title $path [Widget::getoption $path -title]
  70.     set parent [Widget::getoption $path -parent]
  71.     if { ![winfo exists $parent] } {
  72.         set parent [winfo parent $path]
  73.     }
  74.     wm transient $path [winfo toplevel $parent]
  75.     wm withdraw $path
  76.  
  77.     set side [Widget::getoption $path -side]
  78.     if { ![string compare $side "left"] || ![string compare $side "right"] } {
  79.         set orient vertical
  80.     } else {
  81.         set orient horizontal
  82.     }
  83.  
  84.     set bbox  [eval ButtonBox::create $path.bbox [Widget::subcget $path .bbox] \
  85.                    -orient $orient]
  86.     set frame [frame $path.frame -relief flat -borderwidth 0 -background $bg]
  87.  
  88.     if { [set bitmap [Widget::getoption $path -image]] != "" } {
  89.         set label [label $path.label -image $bitmap -background $bg]
  90.     } elseif { [set bitmap [Widget::getoption $path -bitmap]] != "" } {
  91.         set label [label $path.label -bitmap $bitmap -background $bg]
  92.     }
  93.     if { [Widget::getoption $path -separator] } {
  94.                 Separator::create $path.sep -orient $orient -background $bg
  95.     }
  96.     set _widget($path,realized) 0
  97.     set _widget($path,nbut)     0
  98.  
  99.     bind $path <Escape>  "ButtonBox::invoke $path.bbox [Widget::getoption $path -cancel]"
  100.     bind $path <Return>  "ButtonBox::invoke $path.bbox default"
  101.  
  102.     rename $path ::$path:cmd
  103.     proc ::$path { cmd args } "return \[eval Dialog::\$cmd $path \$args\]"
  104.  
  105.     return $path
  106. }
  107.  
  108.  
  109. # ------------------------------------------------------------------------------
  110. #  Command Dialog::configure
  111. # ------------------------------------------------------------------------------
  112. proc Dialog::configure { path args } {
  113.     set res [Widget::configure $path $args]
  114.  
  115.     if { [Widget::hasChanged $path -title title] } {
  116.         wm title $path $title
  117.     }
  118.     if { [Widget::hasChanged $path -background bg] } {
  119.         if { [winfo exists $path.label] } {
  120.             $path.label configure -background $bg
  121.         }
  122.         if { [winfo exists $path.sep] } {
  123.             Separator::configure $path.sep -background $bg
  124.         }
  125.     }
  126.     return $res
  127. }
  128.  
  129.  
  130. # ------------------------------------------------------------------------------
  131. #  Command Dialog::cget
  132. # ------------------------------------------------------------------------------
  133. proc Dialog::cget { path option } {
  134.     return [Widget::cget $path $option]
  135. }
  136.  
  137.  
  138. # ------------------------------------------------------------------------------
  139. #  Command Dialog::getframe
  140. # ------------------------------------------------------------------------------
  141. proc Dialog::getframe { path } {
  142.     return $path.frame
  143. }
  144.  
  145.  
  146. # ------------------------------------------------------------------------------
  147. #  Command Dialog::add
  148. # ------------------------------------------------------------------------------
  149. proc Dialog::add { path args } {
  150.     variable _widget
  151.  
  152.     set res [eval ButtonBox::add $path.bbox \
  153.                  -command [list "Dialog::enddialog $path $_widget($path,nbut)"] $args]
  154.     incr _widget($path,nbut)
  155.     return $res
  156. }
  157.  
  158.  
  159. # ------------------------------------------------------------------------------
  160. #  Command Dialog::itemconfigure
  161. # ------------------------------------------------------------------------------
  162. proc Dialog::itemconfigure { path index args } {
  163.     return [eval ButtonBox::itemconfigure $path.bbox $index $args]
  164. }
  165.  
  166.  
  167. # ------------------------------------------------------------------------------
  168. #  Command Dialog::itemcget
  169. # ------------------------------------------------------------------------------
  170. proc Dialog::itemcget { path index option } {
  171.     return [ButtonBox::itemcget $path.bbox $index $option]
  172. }
  173.  
  174.  
  175. # ------------------------------------------------------------------------------
  176. #  Command Dialog::invoke
  177. # ------------------------------------------------------------------------------
  178. proc Dialog::invoke { path index } {
  179.     ButtonBox::invoke $path.bbox $index
  180. }
  181.  
  182.  
  183. # ------------------------------------------------------------------------------
  184. #  Command Dialog::setfocus
  185. # ------------------------------------------------------------------------------
  186. proc Dialog::setfocus { path index } {
  187.     ButtonBox::setfocus $path.bbox $index
  188. }
  189.  
  190.  
  191. # ------------------------------------------------------------------------------
  192. #  Command Dialog::enddialog
  193. # ------------------------------------------------------------------------------
  194. proc Dialog::enddialog { path result } {
  195.     variable _widget
  196.  
  197.     set _widget($path,result) $result
  198. }
  199.  
  200.  
  201. # ------------------------------------------------------------------------------
  202. #  Command Dialog::draw
  203. # ------------------------------------------------------------------------------
  204. proc Dialog::draw { path {focus ""}} {
  205.     variable _widget
  206.  
  207.     set parent [Widget::getoption $path -parent]
  208.     if { !$_widget($path,realized) } {
  209.         set _widget($path,realized) 1
  210.         if { [llength [winfo children $path.bbox]] } {
  211.             set side [Widget::getoption $path -side]
  212.             if { ![string compare $side "left"] || ![string compare $side "right"] } {
  213.                 set pad  -padx
  214.                 set fill y
  215.             } else {
  216.                 set pad  -pady
  217.                 set fill x
  218.             }
  219.             pack $path.bbox -side $side -anchor [Widget::getoption $path -anchor] -padx 1m -pady 1m
  220.             if { [winfo exists $path.sep] } {
  221.                 pack $path.sep -side $side -fill $fill $pad 2m
  222.             }
  223.         }
  224.         if { [winfo exists $path.label] } {
  225.             pack $path.label -side left -anchor n -padx 3m -pady 3m
  226.         }
  227.         pack $path.frame -padx 1m -pady 1m -fill both -expand yes
  228.     }
  229.  
  230.     if { [winfo exists $parent] } {
  231.         BWidget::place $path 0 0 center $parent
  232.     } else {
  233.         BWidget::place $path 0 0 center
  234.     }
  235.     update idletasks
  236.     wm overrideredirect $path 0
  237.     wm deiconify $path
  238.  
  239.     tkwait visibility $path
  240.     BWidget::focus set $path
  241.     if { [winfo exists $focus] } {
  242.         focus $focus
  243.     } else {
  244.         ButtonBox::setfocus $path.bbox default
  245.     }
  246.  
  247.     if { [set grab [Widget::getoption $path -modal]] != "none" } {
  248.         BWidget::grab $grab $path
  249.         catch {unset _widget($path,result)}
  250.         tkwait variable Dialog::_widget($path,result)
  251.         if { [info exists _widget($path,result)] } {
  252.             set res $_widget($path,result)
  253.             unset _widget($path,result)
  254.         } else {
  255.             set res -1
  256.         }
  257.         withdraw $path
  258.         return $res
  259.     }
  260.     return ""
  261. }
  262.  
  263.  
  264. # ------------------------------------------------------------------------------
  265. #  Command Dialog::withdraw
  266. # ------------------------------------------------------------------------------
  267. proc Dialog::withdraw { path } {
  268.     BWidget::grab release $path
  269.     BWidget::focus release $path
  270.     if { [winfo exists $path] } {
  271.         wm withdraw $path
  272.     }
  273. }
  274.  
  275.  
  276. # ------------------------------------------------------------------------------
  277. #  Command Dialog::_destroy
  278. # ------------------------------------------------------------------------------
  279. proc Dialog::_destroy { path } {
  280.     variable _widget
  281.  
  282.     BWidget::grab  release $path
  283.     BWidget::focus release $path
  284.     catch {unset _widget($path,result)}
  285.     unset _widget($path,realized)
  286.     unset _widget($path,nbut)
  287.  
  288.     Widget::destroy $path
  289.     rename $path {}
  290. }
  291.