/usr/lib/grass64/bwidget/progressbar.tcl is in grass-gui 6.4.3-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 | # ------------------------------------------------------------------------------
# progressbar.tcl
# This file is part of Unifix BWidget Toolkit
# ------------------------------------------------------------------------------
# Index of commands:
# - ProgressBar::create
# - ProgressBar::configure
# - ProgressBar::cget
# - ProgressBar::_destroy
# - ProgressBar::_modify
# ------------------------------------------------------------------------------
namespace eval ProgressBar {
Widget::declare ProgressBar {
{-type Enum normal 0 {normal incremental infinite}}
{-maximum Int 100 0 {>0}}
{-background TkResource "" 0 frame}
{-foreground TkResource blue 0 label}
{-borderwidth TkResource 2 0 frame}
{-troughcolor TkResource "" 0 scrollbar}
{-relief TkResource sunken 0 label}
{-orient Enum horizontal 1 {horizontal vertical}}
{-variable String "" 0}
{-width TkResource 100 0 frame}
{-height TkResource 4m 0 frame}
{-bg Synonym -background}
{-fg Synonym -foreground}
{-bd Synonym -borderwidth}
}
Widget::addmap ProgressBar "" :cmd {-background {} -width {} -height {}}
Widget::addmap ProgressBar "" .bar {-troughcolor -background -borderwidth {} -relief {}}
variable _widget
proc ::ProgressBar { path args } { return [eval ProgressBar::create $path $args] }
proc use {} {}
}
# ------------------------------------------------------------------------------
# Command ProgressBar::create
# ------------------------------------------------------------------------------
proc ProgressBar::create { path args } {
variable _widget
Widget::init ProgressBar $path $args
eval frame $path [Widget::subcget $path :cmd]
set c [eval canvas $path.bar [Widget::subcget $path .bar] -highlightthickness 0]
set fg [Widget::getoption $path -foreground]
if { ![string compare [Widget::getoption $path -orient] "horizontal"] } {
$path.bar create rectangle -1 0 0 0 -fill $fg -outline $fg -tags rect
} else {
$path.bar create rectangle 0 1 0 0 -fill $fg -outline $fg -tags rect
}
set _widget($path,val) 0
set _widget($path,dir) 1
if { [set _widget($path,var) [Widget::getoption $path -variable]] != "" } {
GlobalVar::tracevar variable $_widget($path,var) w "ProgressBar::_modify $path"
after idle ProgressBar::_modify $path
}
bind $path.bar <Destroy> "ProgressBar::_destroy $path"
bind $path.bar <Configure> "ProgressBar::_modify $path"
rename $path ::$path:cmd
proc ::$path { cmd args } "return \[eval ProgressBar::\$cmd $path \$args\]"
return $path
}
# ------------------------------------------------------------------------------
# Command ProgressBar::configure
# ------------------------------------------------------------------------------
proc ProgressBar::configure { path args } {
variable _widget
set res [Widget::configure $path $args]
if { [Widget::hasChanged $path -variable newv] } {
if { $_widget($path,var) != "" } {
GlobalVar::tracevar vdelete $_widget($path,var) w "ProgressBar::_modify $path"
}
if { $newv != "" } {
set _widget($path,var) $newv
GlobalVar::tracevar variable $newv w "ProgressBar::_modify $path"
after idle ProgressBar::_modify $path
} else {
set _widget($path,var) ""
}
}
if { [Widget::hasChanged $path -borderwidth v] ||
[Widget::hasChanged $path -orient v] } {
after idle ProgressBar::_modify $path
}
if { [Widget::hasChanged $path -foreground fg] } {
$path.bar itemconfigure rect -fill $fg -outline $fg
}
return $res
}
# ------------------------------------------------------------------------------
# Command ProgressBar::cget
# ------------------------------------------------------------------------------
proc ProgressBar::cget { path option } {
return [Widget::cget $path $option]
}
# ------------------------------------------------------------------------------
# Command ProgressBar::_destroy
# ------------------------------------------------------------------------------
proc ProgressBar::_destroy { path } {
variable _widget
if { $_widget($path,var) != "" } {
GlobalVar::tracevar vdelete $_widget($path,var) w "ProgressBar::_modify $path"
}
unset _widget($path,var)
unset _widget($path,dir)
Widget::destroy $path
rename $path {}
}
# ------------------------------------------------------------------------------
# Command ProgressBar::_modify
# ------------------------------------------------------------------------------
proc ProgressBar::_modify { path args } {
variable _widget
if { ![GlobalVar::exists $_widget($path,var)] ||
[set val [GlobalVar::getvar $_widget($path,var)]] < 0 } {
catch {place forget $path.bar}
} else {
place $path.bar -relx 0 -rely 0 -relwidth 1 -relheight 1
set type [Widget::getoption $path -type]
if { $val != 0 && [string compare $type "normal"] } {
set val [expr {$val+$_widget($path,val)}]
}
set _widget($path,val) $val
set max [Widget::getoption $path -maximum]
set bd [expr {2*[$path.bar cget -bd]}]
set w [winfo width $path.bar]
set h [winfo height $path.bar]
if { ![string compare $type "infinite"] } {
if { $val > $max } {
set _widget($path,dir) [expr {-$_widget($path,dir)}]
set val 0
set _widget($path,val) 0
}
if { $val <= $max/2.0 } {
set dx0 0.0
set dx1 [expr {double($val)/$max}]
} else {
set dx1 [expr {double($val)/$max}]
set dx0 [expr {$dx1-0.5}]
}
if { $_widget($path,dir) == 1 } {
set x0 $dx0
set x1 $dx1
} else {
set x0 [expr {1-$dx1}]
set x1 [expr {1-$dx0}]
}
if { ![string compare [Widget::getoption $path -orient] "horizontal"] } {
$path.bar coords rect [expr {$x0*$w}] 0 [expr {$x1*$w}] $h
} else {
$path.bar coords rect 0 [expr {$h-$x0*$h}] $w [expr {$x1*$h}]
}
} else {
if { $val > $max } {set val $max}
if { ![string compare [Widget::getoption $path -orient] "horizontal"] } {
$path.bar coords rect -1 0 [expr {$val*$w/$max}] $h
} else {
$path.bar coords rect 0 [expr {$h+1}] $w [expr {$h*($max-$val)}]
}
}
}
update
}
|