/usr/share/tcltk/tcl8.5/Tix8.4.3/Meter.tcl is in tix 8.4.3-4.
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 | # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: Meter.tcl,v 1.3 2001/12/09 05:04:02 idiscovery Exp $
#
# Meter.tcl --
#
# Implements the tixMeter widget
#
# Copyright (c) 1993-1999 Ioi Kim Lam.
# Copyright (c) 2000-2001 Tix Project Group.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
tixWidgetClass tixMeter {
-classname TixMeter
-superclass tixPrimitive
-method {
}
-flag {
-foreground -text -value
}
-configspec {
{-fillcolor fillColor FillColor #8080ff}
{-foreground foreground Foreground black}
{-text text Text ""}
{-value value Value 0}
}
-default {
{.relief sunken}
{.borderWidth 2}
{.width 150}
}
}
proc tixMeter:InitWidgetRec {w} {
upvar #0 $w data
global env
tixChainMethod $w InitWidgetRec
}
#----------------------------------------------------------------------
# Construct widget
#----------------------------------------------------------------------
proc tixMeter:ConstructWidget {w} {
upvar #0 $w data
tixChainMethod $w ConstructWidget
set data(w:canvas) [canvas $w.canvas]
pack $data(w:canvas) -expand yes -fill both
tixMeter:Update $w
}
proc tixMeter:SetBindings {w} {
upvar #0 $w data
tixChainMethod $w SetBindings
}
proc tixMeter:Update {w} {
upvar #0 $w data
# set the width of the canvas
set W [expr $data(-width)-\
([$data(w:root) cget -bd]+[$data(w:root) cget -highlightthickness]*2)]
$data(w:canvas) config -width $W
if {$data(-text) == ""} {
set text [format "%d%%" [expr int($data(-value)*100)]]
} else {
set text $data(-text)
}
# (Create/Modify) the text item.
#
if {![info exists data(text)]} {
set data(text) [$data(w:canvas) create text 0 0 -text $text]
} else {
$data(w:canvas) itemconfig $data(text) -text $text
}
set bbox [$data(w:canvas) bbox $data(text)]
set itemW [expr [lindex $bbox 2]-[lindex $bbox 0]]
set itemH [expr [lindex $bbox 3]-[lindex $bbox 1]]
$data(w:canvas) coord $data(text) [expr $W/2] [expr $itemH/2+4]
set H [expr $itemH + 4]
$data(w:canvas) config -height [expr $H]
set rectW [expr int($W*$data(-value))]
if {![info exists data(rect)]} {
set data(rect) [$data(w:canvas) create rectangle 0 0 $rectW 1000]
} else {
$data(w:canvas) coord $data(rect) 0 0 $rectW 1000
}
$data(w:canvas) itemconfig $data(rect) \
-fill $data(-fillcolor) -outline $data(-fillcolor)
$data(w:canvas) raise $data(text)
}
#----------------------------------------------------------------------
# Configuration
#----------------------------------------------------------------------
proc tixMeter:config-value {w value} {
upvar #0 $w data
set data(-value) $value
tixMeter:Update $w
}
proc tixMeter:config-text {w value} {
upvar #0 $w data
set data(-text) $value
tixMeter:Update $w
}
proc tixMeter:config-fillcolor {w value} {
upvar #0 $w data
set data(-fillcolor) $value
tixMeter:Update $w
}
|