-
Notifications
You must be signed in to change notification settings - Fork 14
/
progressdlg.tcl
97 lines (77 loc) · 3.39 KB
/
progressdlg.tcl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
# ----------------------------------------------------------------------------
# progressdlg.tcl
# This file is part of Unifix BWidget Toolkit
# $Id: progressdlg.tcl,v 1.9 2009/09/08 20:59:15 oberdorfer Exp $
# ----------------------------------------------------------------------------
# Index of commands:
# - ProgressDlg::create
# ----------------------------------------------------------------------------
namespace eval ProgressDlg {
Widget::define ProgressDlg progressdlg Dialog ProgressBar
# to do:
# if {$::tcl_version >= 8.5} {
# set fontdefault TkTextFont
# } elseif {$Widget::_aqua} {
# set fontdefault {helvetica 10}
# } else {
# set fontdefault {helvetica 8}
# }
Widget::bwinclude ProgressDlg Dialog :cmd \
remove {
-modal -image -bitmap -side -anchor -cancel -default
-homogeneous -padx -pady -spacing
}
Widget::bwinclude ProgressDlg ProgressBar .frame.pb \
remove {-orient -width -height}
Widget::declare ProgressDlg {
{-width TkResource 25 0 label}
{-height TkResource 2 0 label}
{-textvariable TkResource "" 0 label}
{-font TkResource "" 0 label}
{-stop String "" 0}
{-command String "" 0}
}
Widget::addmap ProgressDlg :cmd .frame.msg \
{-width {} -height {} -textvariable {} -font {} -background {}}
}
# ----------------------------------------------------------------------------
# Command ProgressDlg::create
# ----------------------------------------------------------------------------
proc ProgressDlg::create { path args } {
array set maps [list ProgressDlg {} :cmd {} .frame.msg {} .frame.pb {}]
array set maps [Widget::parseArgs ProgressDlg $args]
eval [list Dialog::create] $path $maps(:cmd) \
[list -image [Bitmap::get hourglass] \
-modal none -side bottom -anchor e -class ProgressDlg]
Widget::initFromODB ProgressDlg "$path#ProgressDlg" $maps(ProgressDlg)
wm protocol $path WM_DELETE_WINDOW {;}
set frame [Dialog::getframe $path]
bind $frame <Destroy> [list Widget::destroy $path\#ProgressDlg]
$frame configure -cursor watch
eval [list label $frame.msg] $maps(.frame.msg) \
-relief flat -borderwidth 0 \
-highlightthickness 0 -anchor w -justify left
pack $frame.msg -side top -pady 3m -anchor nw -fill x -expand yes
eval [list ProgressBar::create] $frame.pb $maps(.frame.pb) -width 100
pack $frame.pb -side bottom -anchor w -fill x -expand yes
set stop [Widget::cget "$path#ProgressDlg" -stop]
set cmd [Widget::cget "$path#ProgressDlg" -command]
if { $stop != "" && $cmd != "" } {
Dialog::add $path -text $stop -name $stop -command $cmd
}
Dialog::draw $path
BWidget::grab local $path
return [Widget::create ProgressDlg $path 0]
}
# ----------------------------------------------------------------------------
# Command ProgressDlg::configure
# ----------------------------------------------------------------------------
proc ProgressDlg::configure { path args } {
return [Widget::configure "$path#ProgressDlg" $args]
}
# ----------------------------------------------------------------------------
# Command ProgressDlg::cget
# ----------------------------------------------------------------------------
proc ProgressDlg::cget { path option } {
return [Widget::cget "$path#ProgressDlg" $option]
}