1 # vim:set nowrap:
2 # $Name: $
3 # $Id: meter.tcl,v 1.36 2003/09/03 20:53:37 dave Exp $
5 catch { package provide meter 1.1.4 }
7 namespace eval Meter {
8 foreach { db class def } {
9 activebackground activeBackground 0
10 activeforeground activeForeground 0
11 button Button 0
12 color1 Color1 blue
13 color2 Color2 red
14 color3 Color3 yellow
15 command Command ""
16 cpu Cpu 0
17 font Font "Helvetica 8"
18 foreground Foreground ""
19 interval Interval 1
20 legend Legend ""
21 mem Mem 0
22 orient Orient "vertical"
23 padX Pad 2
24 padY Pad 2
25 options - "-width 60 -height 68"
26 disks - ""
27 ifs - ""
28 features - "" } {
29 set op [ string tolower $db ]
30 set default($op) $def
31 if { $class != "-" } { set resource(-$op) "$db $class" }
32 }
33 label .meter:lbl -text x
34 button .meter:but
35 set default(foreground) [ .meter:lbl cget -fg ]
36 set default(activebackground) [ .meter:but cget -activebackground ]
37 set default(activeforeground) [ .meter:but cget -activeforeground ]
38 set priv(window) ""
39 set priv(down) 0
40 set priv(inside) 0
41 unset db class def op
42 }
meter(pathName,args)
|
The meter command creates a new meter widget named pathName.
|
Parameters
|
| pathName | | widget pathname. |
| args | | additional switches.
|
Returns
|
pathName.
|
59 proc meter { pathName args } {
61 if { [ catch { eval Meter::WidgetCommand $pathName \
62 configure \
63 $args } err ] } {
64 return -code error $err
65 }
67 return $pathName
68 }
Meter::WidgetCommand(pathName,args)
|
This procedure creates or modifies the pathName widget, and also becomes the interface to the widget's methods once the widget has been created.
|
Parameters
|
| pathName | | widget pathname. |
| args | | additional switches.
|
Returns
|
pathName.
|
86 proc Meter::WidgetCommand { pathName args } {
88 upvar #0 Meter::$pathName data
90 set cmd [ lindex $args 0 ]
configure method :
96 if { [string match con* $cmd] && [string match $cmd* configure] } {
98 if { ![winfo exists $pathName] } { set first 1 }
If only one option is given, without a value, return a five-item list describing that option. If no options are given, return the five-item descriptions for all options.
106 if { ![info exists first] } {
107 set argc [llength $args]
108 if { $argc == 2 } {
109 set opt [ lindex $args 1 ]
110 if { $opt == "-fg" } { set opt -foreground }
111 if { [regexp {^-} $opt] &&
112 [info exists Meter::resource($opt)] } {
113 foreach { db cl } [ set Meter::resource($opt) ] break
114 set op [ string tolower $db ]
115 return [ list $opt \
116 $db \
117 $cl \
118 [set Meter::default($op)] \
119 [set data($opt)] ]
120 }
121 return [ eval _$pathName $args ]
122 } elseif { $argc == 1 } {
123 set ret [ eval _$pathName $args ]
124 foreach var [ array names data -* ] {
125 foreach { db cl } [ set Meter::resource($var) ] break
126 set op [ string tolower $db ]
127 lappend ret [ list $var \
128 $db \
129 $cl \
130 [set Meter::default($op)] \
131 [set data($var)] ]
132 }
133 lappend ret [ list -fg foreground ]
134 return [ lsort $ret ]
135 }
136 }
Parse parameters; we need at least one of the -cpu, -mem, -if or -disk switches, because we've got to display something.
144 Meter::ParseParams $pathName [ lrange $args 1 end ]
145 if { $features == "" } {
146 return -code error \
147 "must have at least -cpu, -mem, -if, or -disk"
148 }
Create or configure the canvas and let Tk take care of error checking for things like a missing or invalid pathname, bad switches, expected integer, and so on. Errors will be caught and re-thrown by the calling meter command or configure method, to hide the internals.
159 if { [info exists first] } {
160 eval canvas $pathName $options
161 } elseif { $options != $data(options) } {
162 eval _$pathName configure $options
163 }
Stop the running timer or processes.
169 if { ![info exists first] } {
170 Meter::StopMeter $pathName
171 foreach what $data(disks) {
172 if { [info exists data(n$what)] } { unset data(n$what) }
173 }
174 if { [info exists data(dcheck)] } { unset data(dcheck) }
175 }
Save the meter-specific options. This is where the widget data first comes into existence once the options have been validated (i.e. no widget if any invalid options were passed).
183 if { [info exists data(-button)] == 0 ||
184 $data(-button) != $button ||
185 $data(-button) == 0 && $data(-command) != $command } {
186 set but 1
187 } else {
188 set but 0
189 }
190 foreach opt { -activebackground -activeforeground -button \
191 -color1 -color2 -color3 -command -cpu -foreground \
192 -font -interval -legend -mem -orient -padx -pady \
193 options features ifs disks } {
194 regexp {^-?(.*)$} $opt -> var
195 set data($opt) [ set $var ]
196 }
198 if { [llength $data(-legend)] == 0 } {
199 regsub -all {(if|disk):} $data(features) {} data(-legend)
200 }
Overload the widget command.
206 if { [info exists first] } {
207 rename $pathName ::_$pathName
208 proc ::$pathName { args } {
209 set cmd [ info level 0 ]
210 catch {
211 set ret [ eval Meter::WidgetCommand $cmd ]
212 set ok 1
213 } err
214 if { ![info exists ok] } {
215 return -code error $err
216 }
217 return $ret
218 }
219 }
For standard-looking switches not directly supported by the canvas command (e.g. -command), create bindings. Other, application-specific, bindings can be arranged manually by the calling application, using Tk's bind command with the meter's pathname.
229 if { $but } {
230 if { !$data(-button) } {
231 bind $pathName <Enter> {}
232 bind $pathName <Button-1> $data(-command)
233 bind $pathName <ButtonRelease-1> {}
234 bind $pathName <Leave> {}
235 } else {
236 bind $pathName <Enter> { Meter::ButtonEnter %W }
237 bind $pathName <Button-1> { Meter::ButtonDown %W }
238 bind $pathName <ButtonRelease-1> { Meter::ButtonUp %W }
239 bind $pathName <Leave> { Meter::ButtonLeave %W }
240 }
241 }
242 bind $pathName <Destroy> "Meter::DestroyMeter $pathName"
Now (re)create the meter thingies.
248 Meter::CreateMeter $pathName
249 Meter::StartMeter $pathName
250 return
251 }
cget method :
257 if { [string match c* $cmd] && [string match $cmd* cget] } {
258 if { [llength $args] != 2 } {
259 return -code error \
260 "wrong # args: should be \"$pathName cget option\""
261 }
262 set opt [ lindex $args 1 ]
263 if { $opt == "-fg" } { set opt -foreground }
264 if { [regexp {^-} $opt] && [info exists data($opt)] } {
265 return [ set data($opt) ]
266 } else {
267 return [ eval _$pathName $args ]
268 }
269 }
invoke method
275 if { [string match i* $cmd] && [string match $cmd* invoke] } {
276 return [ eval $data(-command) ]
277 }
Other methods :
283 catch {
284 set ret [ eval _$pathName $args ]
285 set ok 1
286 } err
287 if { ![info exists ok] } {
288 regsub {, insert,} $err {& invoke,} err
289 regsub "_$pathName" $err $pathName err
290 return -code error $err
291 }
292 return $ret
293 }
Meter::ParseParams(pathName,argv)
|
Parse parameters; simply filter out the meter-specific switches, and let the rest be passed through to Tk's built-in canvas command via the options list.
|
Parameters
|
| pathName | | widget pathname. |
| argv | | additional switches.
|
Returns
|
None.
|
311 proc Meter::ParseParams { pathName argv } {
313 upvar #0 Meter::$pathName data
Set variables in the caller's scope - naughty... While we're at it, we might as well go for some sensible defaults. If called via the [configure] method, use the current settings.
321 foreach { var } { activebackground
322 activeforeground
323 button
324 color1
325 color2
326 color3
327 command
328 font
329 foreground
330 legend
331 options
332 orient
333 padx
334 pady
335 cpu
336 disks
337 ifs
338 interval
339 mem
340 features } {
341 upvar $var $var
342 if { [info exists data($var)] } {
343 set $var [ set data($var) ]
344 } elseif { [info exists data(-$var)] } {
345 set $var [ set data(-$var) ]
346 } else {
347 set $var [ set Meter::default($var) ]
348 }
349 }
Locate the -if and -disk features.
355 set nif 0
356 set ndisk 0
357 set iif -1
358 set idisk -1
359 set i 0
360 foreach what $features {
361 if { [regexp {^if:} $what] } {
362 if { $iif == -1 } { set iif $i }
363 } elseif { [regexp {^disk:} $what] } {
364 if { $idisk == -1 } { set idisk $i }
365 }
366 incr i
367 }
Filter out the meter-specific options, and do some basic error checking on them. Any other options are just appended to the list for canvas to deal with later.
375 foreach { opt val } $argv {
376 set what [ string range $opt 1 end ]
377 switch -glob -- $opt {
378 -interval -
379 -padx -
380 -pady {
381 if { ![regexp {^[0-9]+$} $val] } {
382 set exint $arg
383 break
384 }
385 }
386 -orient {
387 if { $val != "vertical" && $val != "horizontal" } {
388 set exori $val
389 break
390 }
391 }
392 -foreground -
393 -fg {
394 set what foreground
395 }
396 -activebackground -
397 -activeforeground -
398 -color1 -
399 -color2 -
400 -color3 {
401 catch {
402 .meter:lbl configure -fg $val
403 set ok 1
404 } msg
405 if { ![info exists ok] } {
406 set excol $val
407 break
408 }
409 unset ok
410 }
411 -command -
412 -font -
413 -legend {
414 }
415 -button {
416 set yn [ lsearch "no yes false true 0 1" $val ]
417 if { $yn == -1 } {
418 set exboo $val
419 break
420 }
421 set val [ expr {$yn%2} ]
422 }
423 -cpu -
424 -mem {
425 set yn [ lsearch "no yes false true 0 1" $val ]
426 if { $yn == -1 } {
427 set exboo $val
428 break
429 }
430 set val [ expr {$yn%2} ]
431 set i [ lsearch $features $what ]
432 if { $i == -1 } {
433 if { $val } {
434 lappend features $what
435 }
436 } else {
437 if { !$val } {
438 set features [ lreplace $features $i $i ]
439 }
440 }
441 }
442 -disk {
443 if { $val == "" ||
444 $val == "no" ||
445 $val == "false" ||
446 $val == "0" } {
447 regsub -all {disk:[a-z0-9]+} $features {} features
448 set disks {}
449 set idisk -1
450 set ndisk 0
451 continue
452 } elseif { $val == "yes" ||
453 $val == "true" ||
454 $val == "1" } {
455 set val $Meter::DefaultDisk
456 }
457 set i [ lsearch $disks $val ]
458 if { $i == -1 || $i >= $ndisk } {
459 if { $idisk != -1 } {
460 if { $i >= $ndisk } {
461 set pdisk [ lindex $disks $i ]
462 set disks [ lreplace $disks $i $i zzz ]
463 set i [ lsearch $features disk:$pdisk ]
464 set features [ lreplace $features $i $i disk:zzz ]
465 }
466 if { [lindex $disks $ndisk] != "" } {
467 set disks [ lreplace $disks $ndisk $ndisk $val ]
468 set features [ lreplace $features \
469 $idisk $idisk \
470 disk:$val ]
471 } else {
472 lappend disks $val
473 lappend features disk:$val
474 }
475 while {1} {
476 incr idisk
477 set what [ lindex $features $idisk ]
478 if { $what == "" } {
479 set idisk -1
480 break
481 }
482 if { [regexp {^disk:} $what] } break
483 }
484 } else {
485 lappend disks $val
486 lappend features disk:$val
487 }
488 incr ndisk
489 }
490 continue
491 }
492 -if {
493 if { $val == "" ||
494 $val == "no" ||
495 $val == "false" ||
496 $val == 0 } {
497 regsub -all {if:[a-z0-9]+} $features {} features
498 set ifs {}
499 set iif -1
500 set nif 0
501 continue
502 }
503 set i [ lsearch $ifs $val ]
504 if { $i == -1 || $i >= $nif } {
505 if { $iif != -1 } {
506 if { $i >= $nif } {
507 set pif [ lindex $ifs $i ]
508 set ifs [ lreplace $ifs $i $i zzz ]
509 set i [ lsearch $features if:$pif ]
510 set features [ lreplace $features $i $i if:zzz ]
511 }
512 if { [lindex $ifs $nif] != "" } {
513 set ifs [ lreplace $ifs $nif $nif $val ]
514 set features [ lreplace $features \
515 $iif $iif \
516 if:$val ]
517 } else {
518 lappend ifs $val
519 lappend features if:$val
520 }
521 while {1} {
522 incr iif
523 set what [ lindex $features $iif ]
524 if { $what == "" } {
525 set iif -1
526 break
527 }
528 if { [regexp {^if:} $what] } break
529 }
530 } else {
531 lappend ifs $val
532 lappend features if:$val
533 }
534 incr nif
535 }
536 continue
537 }
538 -* {
539 set i [ lsearch $options $opt ]
540 if { $i == -1 } {
541 lappend options $opt $val
542 } else {
543 set options [ lreplace $options $i [incr i] $opt $val ]
544 }
545 continue
546 }
547 default {
548 set exswi $opt
549 break
550 }
551 }
552 set $what $val
553 }
If any syntax errors were detected, raise them now.
559 if { [info exists exboo] } {
560 set err "expected boolean value but got \"$exboo\""
561 } elseif { [info exists exint] } {
562 set err "expected integer value but got \"$exint\""
563 } elseif { [info exists exswi] } {
564 set err "expected switch but got \"$exswi\""
565 } elseif { [info exists exori] } {
566 set err "bad orientation \"$exori\": must be verical or horizontal"
567 } elseif { [info exists excol] } {
568 set err "unknown color name \"$excol\""
569 }
570 if { [info exists err] } { return -code error $err }
571 }
Meter::CalcFigs(pathName)
|
Calculate dimensions-related figures for the drawings. This procedure creates a series of local variables called things, slots, left, top, right, bot, and slotw in the caller's scope.
|
Parameters
|
| pathName | | widget pathname.
|
Returns
|
None.
|
590 proc Meter::CalcFigs { pathName } {
592 upvar #0 Meter::$pathName data
Naughty Neddy...
598 foreach var { things slots left top right bot slotw } {
599 upvar $var $var
600 }
Determine the number of things to display, and the number of slots used, given that some (future) things might be more than one slot wide.
608 set things 0
609 set slots 0
610 foreach what $data(features) {
611 incr things
612 incr slots
613 }
Now calculate the corners of the drawing area, and slot width.
619 set bw [ _$pathName cget -bd ]
620 set top [ expr {$data(-pady)+2} ]
621 set right [ expr {[_$pathName cget -width]-$data(-padx)+$bw-1} ]
622 if { $data(-orient) == "vertical" } {
623 set left [ expr {$data(-padx)+2} ]
624 set bot [ expr {[_$pathName cget -height]
625 - $data(-pady) + $bw - $data(legspace)} ]
626 set slotw [ expr {(($right-$left)*1.0
627 - ($slots-1)*$data(-padx))/$slots} ]
628 } else {
629 set left [ expr {$data(-padx)+$data(legspace)+1} ]
630 set bot [ expr {[_$pathName cget -height]-$data(-pady)} ]
631 set slotw [ expr {(($bot-$top)*1.0
632 - ($slots-1)*$data(-pady))/$slots} ]
633 }
634 }
Meter::CreateMeter(pathName)
|
Create the static bits of the meter displays, spreading them out in the space available.
|
Parameters
|
| pathName | | widget pathname.
|
Returns
|
None.
|
650 proc Meter::CreateMeter { pathName } {
652 upvar #0 Meter::$pathName data
654 _$pathName delete all
Calculate how much space is needed for the base text.
660 set legspace 0
661 set data(legspace) $legspace
662 _$pathName create text 10 10 \
663 -font $data(-font) \
664 -anchor nw \
665 -tags delme
666 foreach what $data(-legend) {
667 regexp {^(if|disk):(.*)$} $what -> typ what
668 _$pathName itemconfig delme -text $what
669 foreach { x1 y1 x2 y2 } [ _$pathName bbox delme ] break
670 if { $data(-orient) == "vertical" } {
671 set legspace [ expr {$y2-$y1+1} ]
672 } else {
673 set legspace [ expr {$x2-$x1+1} ]
674 }
675 if { $legspace > $data(legspace) } {
676 set data(legspace) $legspace
677 }
678 }
679 _$pathName delete delme
Work out dimensions and things.
685 Meter::CalcFigs $pathName
686 if { $data(-orient) == "vertical" } {
687 set base [ expr {[_$pathName cget -height]
688 - $data(-pady) + [_$pathName cget -bd]} ]
689 } else {
690 set base [ expr {$data(-padx)+1} ]
691 }
693 foreach what $data(features) lbl $data(-legend) {
Create the memory meter if requested. Create the outline boxes at the proper size and position, and stick a legend to the bottom or left. The other rectangles are created with zero size, and will be resized appropriately when the meters are updated, the box serving as the reference point.
703 if { $what == "mem" } {
704 if { $data(-orient) == "vertical" } {
705 _$pathName create rectangle $left $top \
706 [expr {$left+$slotw}] $bot \
707 -outline $data(-foreground) \
708 -tags "membox fgout"
709 _$pathName create text [expr {$left+$slotw/2}] $base \
710 -text $lbl \
711 -fill $data(-foreground) \
712 -font $data(-font) \
713 -tags fgfil \
714 -anchor s
715 } else {
716 _$pathName create rectangle $left $top \
717 $right [expr {$top+$slotw}] \
718 -outline $data(-foreground) \
719 -tags "membox fgout"
720 _$pathName create text $base [expr {$top+$slotw/2}] \
721 -text $lbl \
722 -fill $data(-foreground) \
723 -font $data(-font) \
724 -tags fgfil \
725 -anchor w
726 }
727 _$pathName create rectangle 0 0 0 0 -outline "" -tags mem
728 _$pathName create rectangle 0 0 0 0 -outline "" -tags swap
729 _$pathName create line 0 0 0 0 -fill "" -tags avm
730 # keep the bottom/left edge visible
731 if { $data(-orient) == "vertical" } {
732 _$pathName create line $left $bot \
733 [expr {$left+$slotw+1}] $bot \
734 -fill $data(-foreground) \
735 -tags fgfil
736 set left [ expr {$left+$slotw+$data(-padx)} ]
737 } else {
738 _$pathName create line $left $top \
739 $left [expr {$top+$slotw+1}] \
740 -fill $data(-foreground) \
741 -tags fgfil
742 set top [ expr {$top+$slotw+$data(-pady)} ]
743 }
744 continue
745 }
Create the cpu meter if requested. The basic idea is the same as for the memory meter; just create the box of suitable size and position, the rest are zeroed.
753 if { $what == "cpu" } {
754 if { $data(-orient) == "vertical" } {
755 _$pathName create rectangle $left $top \
756 [expr {$left+$slotw}] $bot \
757 -outline $data(-foreground) \
758 -tags "cpubox fgout"
759 _$pathName create text [expr {$left+$slotw/2}] $base \
760 -text $lbl \
761 -fill $data(-foreground) \
762 -font $data(-font) \
763 -tags fgfil \
764 -anchor s
765 } else {
766 _$pathName create rectangle $left $top \
767 $right [expr {$top+$slotw}] \
768 -outline $data(-foreground) \
769 -tags "cpubox fgout"
770 _$pathName create text $base [expr {$top+$slotw/2}] \
771 -text $lbl \
772 -fill $data(-foreground) \
773 -font $data(-font) \
774 -tags fgfil \
775 -anchor w
776 }
777 _$pathName create rectangle 0 0 0 0 -outline "" -tags "cpu ucpu"
778 _$pathName create rectangle 0 0 0 0 -outline "" -tags "cpu ncpu"
779 _$pathName create rectangle 0 0 0 0 -outline "" -tags "cpu scpu"
780 # baseline
781 if { $data(-orient) == "vertical" } {
782 _$pathName create line $left $bot \
783 [expr {$left+$slotw+1}] $bot \
784 -fill $data(-foreground) \
785 -tags fgfil
786 set left [ expr {$left+$slotw+$data(-padx)} ]
787 } else {
788 _$pathName create line $left $top \
789 $left [expr {$top+$slotw+1}] \
790 -fill $data(-foreground) \
791 -tags fgfil
792 set top [ expr {$top+$slotw+$data(-pady)} ]
793 }
794 continue
795 }
Create the network meters if requested - same idea again.
801 if { [regexp {^if:(.*)$} $what -> what] } {
802 if { $data(-orient) == "vertical" } {
803 _$pathName create rectangle $left $top \
804 [expr {$left+$slotw}] $bot \
805 -outline $data(-foreground) \
806 -tags "${what}box fgout"
807 _$pathName create text [expr {$left+$slotw/2}] $base \
808 -text $lbl \
809 -fill $data(-foreground) \
810 -font $data(-font) \
811 -tags fgfil \
812 -anchor s
813 } else {
814 _$pathName create rectangle $left $top \
815 $right [expr {$top+$slotw}] \
816 -outline $data(-foreground) \
817 -tags "${what}box fgout"
818 _$pathName create text $base [expr {$top+$slotw/2}] \
819 -text $lbl \
820 -fill $data(-foreground) \
821 -font $data(-font) \
822 -tags fgfil \
823 -anchor w
824 }
825 _$pathName create rectangle 0 0 0 0 -outline "" -tags "$what rx$what"
826 _$pathName create rectangle 0 0 0 0 -outline "" -tags "$what tx$what"
827 # baseline
828 if { $data(-orient) == "vertical" } {
829 _$pathName create line $left $bot \
830 [expr {$left+$slotw+1}] $bot \
831 -fill $data(-foreground) \
832 -tags "${what}base fgfil"
833 set left [ expr {$left+$slotw+$data(-padx)} ]
834 } else {
835 _$pathName create line $left $top \
836 $left [expr {$top+$slotw+1}] \
837 -fill $data(-foreground) \
838 -tags "${what}base fgfil"
839 set top [ expr {$top+$slotw+$data(-pady)} ]
840 }
841 continue
842 }
And the same again if it's a disk meter.
848 if { [regexp {^disk:(.*)$} $what -> what] } {
849 if { $data(-orient) == "vertical" } {
850 _$pathName create rectangle $left $top \
851 [expr {$left+$slotw}] $bot \
852 -outline $data(-foreground) \
853 -tags "${what}box fgout"
854 _$pathName create text [expr {$left+$slotw/2}] $base \
855 -text $lbl \
856 -fill $data(-foreground) \
857 -font $data(-font) \
858 -tags fgfil \
859 -anchor s
860 } else {
861 _$pathName create rectangle $left $top \
862 $right [expr {$top+$slotw}] \
863 -outline $data(-foreground) \
864 -tags "${what}box fgout"
865 _$pathName create text $base [expr {$top+$slotw/2}] \
866 -text $lbl \
867 -fill $data(-foreground) \
868 -font $data(-font) \
869 -tags fgfil \
870 -anchor w
871 }
872 _$pathName create rectangle 0 0 0 0 -outline "" -tags "$what i$what"
873 _$pathName create rectangle 0 0 0 0 -outline "" -tags "$what o$what"
874 # baseline
875 if { $data(-orient) == "vertical" } {
876 _$pathName create line $left $bot \
877 [expr {$left+$slotw+1}] $bot \
878 -fill $data(-foreground) \
879 -tags "${what}base fgfil"
880 set left [ expr {$left+$slotw+$data(-padx)} ]
881 } else {
882 _$pathName create line $left $top \
883 $left [expr {$top+$slotw+1}] \
884 -fill $data(-foreground) \
885 -tags "${what}base fgfil"
886 set top [ expr {$top+$slotw+$data(-pady)} ]
887 }
888 continue
889 }
890 }
891 }
Meter::DestroyMeter(pathName)
|
When a meter widget is destroyed, kill any events, processes or variables associated with it.
|
Parameters
|
| pathName | | widget pathname.
|
Returns
|
None.
|
907 proc Meter::DestroyMeter { pathName } {
909 upvar #0 Meter::$pathName data
911 Meter::StopMeter $pathName
912 unset data
913 rename $pathName {}
914 }
Meter::Button*(w)
|
Canvas mouse bindings for emulating button behaviour (flashing as the cursor enters and leaves, pressing in when the mouse is clicked, etc.).
|
Parameters
|
| w | | window pathname.
|
Returns
|
None.
|
931 proc Meter::ButtonEnter w {
932 upvar #0 Meter::priv priv
933 upvar #0 Meter::$w data
934 if { ![info exists priv(background)] } {
935 set priv(background) [ _$w cget -background ]
936 }
937 _$w itemconfigure fgout -outline $data(-activeforeground)
938 _$w itemconfigure fgfil -fill $data(-activeforeground)
939 _$w configure -background $data(-activebackground)
940 if { $priv(down) == 1 && $priv(window) == $w } {
941 _$w configure -relief sunken
942 }
943 set priv(inside) 1
944 }
946 proc Meter::ButtonLeave w {
947 upvar #0 Meter::priv priv
948 upvar #0 Meter::$w data
949 if { $priv(down) == 1 && $priv(window) == $w } {
950 _$w configure -relief $priv(relief)
951 }
952 if { [info exists priv(background)] } {
953 _$w configure -background $priv(background)
954 unset priv(background)
955 }
956 _$w itemconfigure fgout -outline $data(-foreground)
957 _$w itemconfigure fgfil -fill $data(-foreground)
958 set priv(inside) 0
959 }
961 proc Meter::ButtonDown w {
962 upvar #0 Meter::priv priv
963 upvar #0 Meter::$w data
964 set priv(relief) [ _$w cget -relief ]
965 set priv(window) $w
966 _$w configure -relief sunken
967 set priv(down) 1
968 }
970 proc Meter::ButtonUp w {
971 upvar #0 Meter::priv priv
972 upvar #0 Meter::$w data
973 _$w configure -relief $priv(relief)
974 set priv(window) ""
975 set priv(down) 0
976 if { $priv(inside) } {
977 eval $data(-command)
978 }
979 }
Meter::StartMeter(pathName)
|
Start off the update mechanism for the meters. On BSD systems, this will be a fileevent on a pipe from the vmstat, netstat or iostat command; on Linux-type systems, this will be an after event to check the /proc filesystem every -interval seconds.
|
Parameters
|
| pathName | | widget pathname.
|
Returns
|
None.
|
999 proc Meter::StartMeter { pathName } {
1001 upvar #0 Meter::$pathName data
1002 upvar #0 Meter::totals total
Linux:
1008 if { [file readable /proc/stat] &&
1009 [file readable /proc/meminfo] &&
1010 [file readable /proc/net/dev] } {
1011 foreach what { puser pnice psys pidle } {
1012 set data($what) 0
1013 }
1014 foreach what $data(features) {
1015 if { [regexp {^if:(.*)$} $what -> iface] } {
1016 set data(prx$iface) 0
1017 set data(ptx$iface) 0
1018 if { ![info exists total($iface)] } { set total($iface) 0 }
1019 }
1020 }
1021 Meter::UpdateFromProc $pathName
1022 return
1023 }
BSD:
1029 if { $data(-cpu) || $data(-mem) } {
1030 set fd [ open "| /usr/bin/vmstat -w $data(-interval)" r ]
1031 set data(vmstatfd) $fd
1032 set data(vmstatpid) [ pid $fd ]
1033 set data(physmem) [ expr {[exec /sbin/sysctl -n hw.physmem]/1024} ]
1034 fileevent $fd readable \
1035 "Meter::UpdateFromVmstat $pathName $fd"
1036 }
1037 if { $data(ifs) != "" } {
1038 foreach what $data(ifs) {
1039 set fd [ open "| /usr/bin/netstat -w $data(-interval) -I $what" r ]
1040 set data(${what}netstatfd) $fd
1041 set data(${what}netstatpid) [ pid $fd ]
1042 if { ![info exists total($what)] } { set total($what) 0 }
1043 fileevent $fd readable \
1044 "Meter::UpdateFromNetstat $pathName $fd $what"
1045 }
1046 }
1047 if { $data(disks) != "" } {
1048 set fd [ open "| /usr/sbin/iostat -w $data(-interval) -d $data(disks)" r ]
1049 set data(iostatfd) $fd
1050 set data(iostatpid) [ pid $fd ]
1051 fileevent $fd readable "Meter::UpdateFromIostat $pathName $fd"
1052 }
1053 return
1054 }
Meter::StopMeter(pathName)
|
Stop the meters being updated, by cancelling any timers and stopping any processes.
|
Parameters
|
| pathName | | widget pathname.
|
Returns
|
None.
|
1070 proc Meter::StopMeter { pathName } {
1072 upvar #0 Meter::$pathName data
Linux: clear out the current and previous values, because they need to be fresh. We hang on to the disk and network totals, so the ranges are consistent across configures.
1080 if { [info exists data(afterid)] } {
1081 after cancel $data(afterid)
1082 unset data(afterid)
1083 foreach pat { r?d? w?d?
1084 pr?d? pw?d?
1085 prx* ptx*
1086 psys puser
1087 pnice pidle } {
1088 foreach fld [ array names data $pat ] {
1089 unset data($fld)
1090 }
1091 }
1092 }
BSD: processes to kill and pipes to close; but no need to clear any values, apart from the pids and fds.
1099 foreach what [ array names data *pid ] {
1100 regexp {^(.*)pid$} $what -> what
1101 set fd [ set data(${what}fd) ]
1102 set pid [ set data(${what}pid) ]
1103 fileevent $fd readable ""
1104 catch { exec /bin/kill $pid }
1105 catch { close $fd }
1106 unset data(${what}fd)
1107 unset data(${what}pid)
1108 }
1109 }
Meter::UpdateFromVmstat(pathName,chan)
|
[BSD] Read a line of data from the vmstat pipe, and update the CPU and/or memory meters with the info it gives.
|
Parameters
|
| pathName | | widget pathname. |
| chan | | pipe channel.
|
Returns
|
None.
|
1127 proc Meter::UpdateFromVmstat { pathName chan } {
1129 upvar #0 Meter::$pathName data
End-of-file means the vmstat process exited.
1135 if { [eof $chan] } {
1136 catch { close $chan }
1137 unset data(vmstatfd)
1138 unset data(vmstatpid)
1139 return
1140 }
Read a line from the pipe, ignore headers.
1146 gets $chan line
1147 if { ![regexp {^[0-9 ]+$} $line] } return
Work out dimensions and things.
1153 Meter::CalcFigs $pathName
1154 if { $data(-orient) == "vertical" } {
1155 set len [ expr {$bot-$top} ]
1156 } else {
1157 set len [ expr {$right-$left} ]
1158 }
Update the memory meter. Ignore cases where the avm and fre columns coalesce (which happens when the free list is more than five digits wide).
1168 if { $data(-mem) } {
1169 if { [string length [lindex $line 3]] < 8 } {
1170 set mfree [ lindex $line 4 ]
1171 set atot [ lindex $line 3 ]
1172 set mtot $data(physmem).0
1173 set ause $atot
1174 set muse [ expr {$mtot - $mfree - $atot} ]
1175 set alen [ expr {($ause/$mtot)*$len} ]
1176 set mlen [ expr {($muse/$mtot)*$len} ]
1177 foreach { x1 y1 x2 y2 } [ _$pathName coords membox ] break
1178 _$pathName itemconfigure mem -fill "" -outline ""
1179 _$pathName itemconfigure avm -fill ""
1180 if { $mlen } {
1181 if { $data(-orient) == "vertical" } {
1182 set y1 [ expr {$bot-$alen-$mlen} ]
1183 set y2 $bot
1184 } else {
1185 set x1 [ expr {$left+$alen+$mlen} ]
1186 set x2 $left
1187 }
1188 _$pathName coords mem $x1 $y1 $x2 $y2
1189 _$pathName itemconfigure mem -fill $data(-color1) \
1190 -outline $data(-color1)
1191 }
1192 if { $alen } {
1193 if { $data(-orient) == "vertical" } {
1194 set y1 [ expr {$bot-$alen} ]
1195 _$pathName coords avm $x1 $y1 [expr {$x2+1}] $y1
1196 } else {
1197 set x1 [ expr {$left+$alen} ]
1198 _$pathName coords avm $x1 $y1 $x1 [expr {$y2+1}]
1199 }
1200 _$pathName itemconfigure avm -fill $data(-foreground)
1201 }
1202 }
1203 }
Update the CPU meter. Start counting CPU fields from the end of the list, as there may be a variable number of disk fields in between.
1212 if { $data(-cpu) } {
1213 set n [ llength $line ]
1214 set us [ lindex $line [expr {$n-3}] ]
1215 set sy [ lindex $line [expr {$n-2}] ]
1216 set id [ lindex $line [expr {$n-1}] ]
1217 # uncomment for BSD screenshot
1218 #set us 40
1219 #set sy 20
1220 #set id 40
1221 set ulen [ expr {($us/100.0)*$len} ]
1222 set slen [ expr {($sy/100.0)*$len} ]
1223 _$pathName itemconfigure cpu -fill "" -outline ""
1224 foreach { x1 y1 x2 y2 } [ _$pathName coords cpubox ] break
1225 if { $ulen } {
1226 if { $data(-orient) == "vertical" } {
1227 set y1 [ expr {$bot-$ulen} ]
1228 set y2 $bot
1229 } else {
1230 set x1 [ expr {$left+$ulen} ]
1231 set x2 $left
1232 }
1233 _$pathName coords ucpu $x1 $y1 $x2 $y2
1234 _$pathName itemconfigure ucpu -fill $data(-color1) \
1235 -outline $data(-color1)
1236 }
1237 if { $slen } {
1238 if { $data(-orient) == "vertical" } {
1239 set y1 [ expr {$bot-$ulen-$slen} ]
1240 set y2 [ expr {$bot-$ulen} ]
1241 } else {
1242 set x1 [ expr {$left+$ulen+$slen} ]
1243 set x2 [ expr {$left+$ulen} ]
1244 }
1245 _$pathName coords scpu $x1 $y1 $x2 $y2
1246 _$pathName itemconfigure scpu -fill $data(-color2) \
1247 -outline $data(-color2)
1248 }
1249 }
1250 }
Meter::UpdateFromNetstat(pathName,chan,iface)
|
[BSD] Read a line of data from the netstat pipe, and update the corresponding network meter with the info it gives.
|
Parameters
|
| pathName | | widget pathname. |
| chan | | pipe channel. |
| iface | | interface name.
|
Returns
|
None.
|
1269 proc Meter::UpdateFromNetstat { pathName chan iface } {
1271 upvar #0 Meter::$pathName data
1272 upvar #0 Meter::totals total
End-of-file means the netstat process exited.
1278 if { [eof $chan] } {
1279 catch { close $chan }
1280 unset data(${iface}netstatfd)
1281 unset data(${iface}netstatpid)
1282 return
1283 }
Read a line from the pipe, ignoring headers.
1289 gets $chan line
1290 if { ![regexp {^[0-9 ]+$} $line] } return
Work out dimensions and things.
1296 Meter::CalcFigs $pathName
1297 if { $data(-orient) == "vertical" } {
1298 set len [ expr {$bot-$top} ]
1299 } else {
1300 set len [ expr {$right-$left} ]
1301 }
Update the network meter. A straightforward job of picking out the bytes in and bytes out columns, and expressing them as ratios of the highest total so far.
1311 set rx [lindex $line 2].0
1312 set tx [lindex $line 5].0
1313 set tot [expr {$rx+$tx}]
1314 # uncomment for BSD screenshot
1315 #set rx 30.0
1316 #set tx 50.0
1317 #set tot 100.0
1318 if { $tot > [set total($iface)] } {
1319 set total($iface) $tot
1320 } else {
1321 set tot [set total($iface)]
1322 }
1323 if { !$tot } { set tot 1 }
1324 set rxlen [ expr {($rx/$tot)*$len} ]
1325 set txlen [ expr {($tx/$tot)*$len} ]
1326 _$pathName itemconfigure $iface -fill "" -outline ""
1327 foreach { x1 y1 x2 y2 } [ _$pathName coords ${iface}box ] break
1328 if { $rxlen } {
1329 if { $data(-orient) == "vertical" } {
1330 set y1 [ expr {$bot-$rxlen} ]
1331 set y2 $bot
1332 } else {
1333 set x1 [ expr {$left+$rxlen} ]
1334 set x2 $left
1335 }
1336 _$pathName coords rx$iface $x1 $y1 $x2 $y2
1337 _$pathName itemconfigure rx$iface -fill $data(-color1) \
1338 -outline $data(-color1)
1339 }
1340 if { $txlen } {
1341 if { $data(-orient) == "vertical" } {
1342 set y1 [ expr {$bot-$rxlen-$txlen} ]
1343 set y2 [ expr {$bot-$rxlen} ]
1344 } else {
1345 set x1 [ expr {$left+$rxlen+$txlen} ]
1346 set x2 [ expr {$left+$rxlen} ]
1347 }
1348 _$pathName coords tx$iface $x1 $y1 $x2 $y2
1349 _$pathName itemconfigure tx$iface -fill $data(-color2) \
1350 -outline $data(-color2)
1351 }
1352 }
Meter::UpdateFromIostat(pathName,chan)
|
[BSD] Read a line of data from the iostat pipe, and update the corresponding disk meter with the info it gives.
|
Parameters
|
| pathName | | widget pathname. |
| chan | | pipe channel.
|
Returns
|
None.
|
1370 proc Meter::UpdateFromIostat { pathName chan } {
1372 upvar #0 Meter::$pathName data
1373 upvar #0 Meter::totals total
End-of-file means the iostat process exited.
1379 if { [eof $chan] } {
1380 catch { close $chan }
1381 unset data(iostatfd)
1382 unset data(iostatpid)
1383 foreach disk $data(disks) {
1384 if { [info exists data(n$disk)] } { unset data(n$disk) }
1385 }
1386 if { [info exists data(dcheck)] } { unset data(dcheck) }
1387 return
1388 }
Read a line from the pipe. Ignore headers, but expect at least one header line to mention the disk.
1395 gets $chan line
1396 if { ![regexp {^[0-9. ]+$} $line] } {
1397 if { ![info exists data(dcheck)] &&
1398 [regexp {^[a-z0-9 ]+$} $line] } {
1399 foreach disk $data(disks) {
1400 set n [ lsearch $line $disk ]
1401 if { ![info exists total($disk)] } { set total($disk) 0 }
1402 if { $n == -1 } {
1403 set data(n$disk) -1
1404 } else {
1405 set data(n$disk) [ expr {2+$n*3} ]
1406 }
1407 }
1408 set data(dcheck) 1
1409 }
1410 return
1411 }
Work out dimensions and things.
1417 Meter::CalcFigs $pathName
1418 if { $data(-orient) == "vertical" } {
1419 set len [ expr {$bot-$top} ]
1420 } else {
1421 set len [ expr {$right-$left} ]
1422 }
Update the disk meters. The stats come in groups of three columns; take the MB/s column for each disk, and express it as a ratio of the highest so far.
1431 foreach disk $data(disks) {
1433 set n [ set data(n$disk) ]
1434 if { $n == -1 } continue
1436 set mbs [ lindex $line $n ]
1437 set tot $mbs
1438 # uncomment for BSD screenshot
1439 #set mbs 25
1440 #set tot 100.0
1441 if { $tot > [set total($disk)] } {
1442 set total($disk) $tot
1443 } else {
1444 set tot [set total($disk)]
1445 }
1446 if { !$tot } { set tot 1 }
1447 set ilen [ expr {($mbs/$tot)*$len} ]
1448 _$pathName itemconfigure $disk -fill "" -outline ""
1449 foreach { x1 y1 x2 y2 } [ _$pathName coords ${disk}box ] break
1450 if { $ilen } {
1451 if { $data(-orient) == "vertical" } {
1452 set y1 [ expr {$bot-$ilen} ]
1453 set y2 $bot
1454 } else {
1455 set x1 [ expr {$left+$ilen} ]
1456 set x2 $left
1457 }
1458 _$pathName coords i$disk $x1 $y1 $x2 $y2
1459 _$pathName itemconfigure i$disk -fill $data(-color1) \
1460 -outline $data(-color1)
1461 }
1462 }
1463 }
Meter::UpdateFromProc(pathName)
|
[Linux] Read the /proc/stat, /proc/meminfo and/or /proc/net/dev files, and update the CPU, memory or network interface meters with the information they give.
|
Parameters
|
| pathName | | widget pathname.
|
Returns
|
None.
|
1481 proc Meter::UpdateFromProc { pathName } {
1483 upvar #0 Meter::$pathName data
1484 upvar #0 Meter::totals total
Work out dimensions and things.
1490 Meter::CalcFigs $pathName
1491 if { $data(-orient) == "vertical" } {
1492 set len [ expr {$bot-$top} ]
1493 } else {
1494 set len [ expr {$right-$left} ]
1495 }
Update the memory meter. The /proc/meminfo file conveniently has the amounts of physical memory and swap space available and in use. It also gives the amounts of system, buffered and cached memory, but I'll just ignore these for now.
1506 if { $data(-mem) } {
1507 set mtot 0
1508 set stot 0
1509 set ause 0
1510 set fd [ open /proc/meminfo r ]
1511 while { !$mtot || !$stot } {
1512 gets $fd line
1513 switch [ lindex $line 0 ] {
1514 "Mem:" {
1515 foreach { tg mtot muse mfree ms mb mc } $line break
1516 set muse $muse.0
1517 set mtot $mtot.0
1518 }
1519 "Swap:" {
1520 foreach { tg stot suse sfree } $line break
1521 set suse $suse.0
1522 set stot $stot.0
1523 }
1524 }
1525 }
1526 close $fd
1527 set tot [ expr {1.0*($mtot+$stot)} ]
1528 set mlen [ expr {($muse/$tot)*$len} ]
1529 set slen [ expr {($suse/$tot)*$len} ]
1530 _$pathName itemconfigure mem -fill "" -outline ""
1531 _$pathName itemconfigure swap -fill "" -outline ""
1532 foreach { x1 y1 x2 y2 } [ _$pathName coords membox ] break
1533 if { $mlen } {
1534 if { $data(-orient) == "vertical" } {
1535 set y1 [ expr {$bot-$mlen} ]
1536 set y2 $bot
1537 } else {
1538 set x1 [ expr {$left+$mlen} ]
1539 set x2 $left
1540 }
1541 _$pathName coords mem $x1 $y1 $x2 $y2
1542 _$pathName itemconfigure mem -fill $data(-color1) \
1543 -outline $data(-color1)
1544 }
1545 if { $slen } {
1546 if { $data(-orient) == "vertical" } {
1547 set y1 [ expr {$bot-$mlen-$slen} ]
1548 set y2 [ expr {$bot-$mlen} ]
1549 } else {
1550 set x1 [ expr {$left+$mlen+$slen} ]
1551 set x2 [ expr {$left+$mlen} ]
1552 }
1553 _$pathName coords swap $x1 $y1 $x2 $y2
1554 _$pathName itemconfigure swap -fill $data(-color2) \
1555 -outline $data(-color2)
1556 }
1557 }
Update the CPU and/or disk meters. The /proc/stat file contains - among other things - the number of jiffies spent in user, nice, system, and idle cpu mode since the system was booted (or since the jiffy count last wrapped round, which happens about every one and a third years). We compare these against the previous counts, and convert the differences to ratios of the total.
Note: I don't check for the current jiffy count being less than the previous - I'm not going to keep my machine switched on for one and a third years, just for an effect I'll probably miss in a blink... :)
2.2 kernels give the disk stats we're after, on the two lines starting with disk_rblk and disk_wblk. Each line gives the cumulative read/write counts for all of the first four SCSI or IDE disks. 2.4 kernels give all the disk stats on one line, starting with disk_io, and identify the items with the device type and number.
Note: disk stats -being cumulative- might also overflow, but I'm not bothered...
1585 if { $data(-cpu) != 0 || $data(disks) != {} } {
1587 if { $data(-cpu) } {
1588 set ptot [ expr { $data(puser) + $data(pnice)
1589 + $data(psys) + $data(pidle) } ]
1590 set cidle 0
1591 }
1593 set fd [ open /proc/stat r ]
1594 while { ![eof $fd] } {
1595 gets $fd line
1596 if { $data(-cpu) && [regexp {^cpu} $line] != 0 } {
1597 foreach { tg cuser cnice csys cidle } $line break
1598 set ctot [ expr {$cuser+$cnice+$csys+$cidle} ]
1599 }
1600 if { $data(disks) != {} } {
1601 if { [regexp {^disk_([rw])blk} $line -> rw] } {
1602 # 2.2 kernel disk stats
1603 set tt $Meter::devtype
1604 set cc 0
1605 foreach item $line {
1606 if { $cc } {
1607 set i [ format %c [expr {$cc+96}] ]
1608 if { ![info exists data(p$rw${tt}d$i)] } {
1609 set data(p$rw${tt}d$i) $item
1610 }
1611 set pb [ set data(p$rw${tt}d$i) ]
1612 set data($rw${tt}d$i) [ expr {$item-$pb} ]
1613 set data(p$rw${tt}d$i) $item
1614 }
1615 incr cc
1616 }
1617 } elseif { [regexp {^disk_io} $line] } {
1618 # 2.4 kernel disk stats
1619 set cc 0
1620 foreach item $line {
1621 if { $cc } {
1622 scan $item "(%u,%u):(%*u,%*u,%u,%*u,%u)" tt i rb wb
1623 switch $tt {
1624 8 { set tt s ; set off 97 }
1625 2 { set tt f ; set off x }
1626 3 { set tt h ; set off 97 }
1627 22 { set tt h ; set off 99 }
1628 }
1629 if { $tt != "f" } {
1630 set i [ format %c [expr {$i+$off}] ]
1631 }
1632 if { ![info exists data(pr${tt}d$i)] } {
1633 set data(pr${tt}d$i) $rb
1634 set data(pw${tt}d$i) $wb
1635 }
1636 set prb [ set data(pr${tt}d$i) ]
1637 set pwb [ set data(pw${tt}d$i) ]
1638 set data(r${tt}d$i) [ expr {$rb-$prb} ]
1639 set data(w${tt}d$i) [ expr {$wb-$pwb} ]
1640 set data(pr${tt}d$i) $rb
1641 set data(pw${tt}d$i) $wb
1642 }
1643 incr cc
1644 }
1645 }
1646 }
1647 }
1648 close $fd
1650 # update the cpu meter
1651 if { $data(-cpu) } {
1652 set tot [ expr {1.0*($ctot-$ptot)} ]
1653 set ulen [ expr {(($cuser-$data(puser))/$tot)*$len} ]
1654 set nlen [ expr {(($cnice-$data(pnice))/$tot)*$len} ]
1655 set slen [ expr {(($csys-$data(psys))/$tot)*$len} ]
1656 # uncomment for Linux screenshot
1657 #set ulen [ expr {0.40*$len} ]
1658 #set nlen [ expr {0.00*$len} ]
1659 #set slen [ expr {0.20*$len} ]
1660 set data(puser) $cuser
1661 set data(pnice) $cnice
1662 set data(psys) $csys
1663 set data(pidle) $cidle
1664 _$pathName itemconfigure cpu -fill "" -outline ""
1665 foreach { x1 y1 x2 y2 } [ _$pathName coords cpubox ] break
1666 if { $ulen } {
1667 if { $data(-orient) == "vertical" } {
1668 set y1 [ expr {$bot-$ulen} ]
1669 set y2 $bot
1670 } else {
1671 set x1 [ expr {$left+$ulen} ]
1672 set x2 $left
1673 }
1674 _$pathName coords ucpu $x1 $y1 $x2 $y2
1675 _$pathName itemconfigure ucpu -fill $data(-color1) \
1676 -outline $data(-color1)
1677 }
1678 if { $nlen } {
1679 if { $data(-orient) == "vertical" } {
1680 set y1 [ expr {$bot-$ulen-$nlen} ]
1681 set y2 [ expr {$bot-$ulen} ]
1682 } else {
1683 set x1 [ expr {$left+$ulen+$nlen} ]
1684 set x2 [ expr {$left+$ulen} ]
1685 }
1686 _$pathName coords ncpu $x1 $y1 $x2 $y2
1687 _$pathName itemconfigure ncpu -fill $data(-color3) \
1688 -outline $data(-color3)
1689 }
1690 if { $slen } {
1691 if { $data(-orient) == "vertical" } {
1692 set y1 [ expr {$bot-$ulen-$nlen-$slen} ]
1693 set y2 [ expr {$bot-$ulen-$nlen} ]
1694 } else {
1695 set x1 [ expr {$left+$ulen+$nlen+$slen} ]
1696 set x2 [ expr {$left+$ulen+$nlen} ]
1697 }
1698 _$pathName coords scpu $x1 $y1 $x2 $y2
1699 _$pathName itemconfigure scpu -fill $data(-color2) \
1700 -outline $data(-color2)
1701 }
1702 }
1704 # update disk meters
1705 if { $data(disks) != {} } {
1706 foreach disk $data(disks) {
1707 if { [info exists data(r$disk)] } {
1708 set in [ set data(r$disk) ].0
1709 set out [ set data(w$disk) ].0
1710 if { [info exists total($disk)] } {
1711 set tot [ set total($disk) ]
1712 } else {
1713 set tot 1
1714 }
1715 set ctot [ expr {$in+$out} ]
1716 if { $ctot > $tot } { set tot $ctot }
1717 set ilen [ expr {($in/$tot)*$len} ]
1718 set olen [ expr {($out/$tot)*$len} ]
1719 # uncomment for Linux screenshot
1720 #set ilen [ expr {0.30*$len} ]
1721 #set olen [ expr {0.10*$len} ]
1722 _$pathName itemconfigure $disk -fill "" -outline ""
1723 foreach { x1 y1 x2 y2 } \
1724 [ _$pathName coords ${disk}box ] break
1725 if { $ilen } {
1726 if { $data(-orient) == "vertical" } {
1727 set y1 [ expr {$bot-$ilen} ]
1728 set y2 $bot
1729 } else {
1730 set x1 [ expr {$left+$ilen} ]
1731 set x2 $left
1732 }
1733 _$pathName coords i$disk $x1 $y1 $x2 $y2
1734 _$pathName itemconfigure i$disk -fill $data(-color1) \
1735 -outline $data(-color1)
1736 }
1737 if { $olen } {
1738 if { $data(-orient) == "vertical" } {
1739 set y1 [ expr {$bot-$ilen-$olen} ]
1740 set y2 [ expr {$bot-$ilen} ]
1741 } else {
1742 set x1 [ expr {$left+$ilen+$olen} ]
1743 set x2 [ expr {$left+$ilen} ]
1744 }
1745 _$pathName coords o$disk $x1 $y1 $x2 $y2
1746 _$pathName itemconfigure o$disk -fill $data(-color2) \
1747 -outline $data(-color2)
1748 }
1749 set total($disk) $tot
1750 }
1751 }
1752 }
1753 }
Update the network meters. The /proc/net/dev file contains - among other things - the number of bytes sent and received across the network interfaces. We compare these against the previous counts, and convert the differences to ratios of the highest total so far.
1764 if { $data(ifs) != "" } {
1765 set fd [ open /proc/net/dev r ]
1766 if { ![info exists data(nrxp)] } {
1767 set data(nrxp) { *(.+):} ;# interface
1768 set data(nrxp) "$data(nrxp) *(\[0-9\]+)" ;# rx bytes
1769 set data(nrxp) "$data(nrxp) +\[0-9\]+" ;# rx packets
1770 set data(nrxp) "$data(nrxp) +\[0-9\]+" ;# rx errs
1771 set data(nrxp) "$data(nrxp) +\[0-9\]+" ;# rx drop
1772 set data(nrxp) "$data(nrxp) +\[0-9\]+" ;# rx fifo
1773 set data(nrxp) "$data(nrxp) +\[0-9\]+" ;# rx frame
1774 set data(nrxp) "$data(nrxp) +\[0-9\]+" ;# rx colls/compressed
1775 set data(nrxp) "$data(nrxp) +\[0-9\]+" ;# rx compressed/multicast
1776 set data(nrxp) "$data(nrxp) +(\[0-9\]+)" ;# tx bytes
1777 set data(nrxp) "$data(nrxp) +\[0-9\]+" ;# tx packets
1778 set data(nrxp) "$data(nrxp) +\[0-9\]+" ;# tx errs
1779 set data(nrxp) "$data(nrxp) +\[0-9\]+" ;# tx drop
1780 set data(nrxp) "$data(nrxp) +\[0-9\]+" ;# tx fifo
1781 set data(nrxp) "$data(nrxp) +\[0-9\]+" ;# tx colls
1782 set data(nrxp) "$data(nrxp) +\[0-9\]+" ;# tx carrier
1783 set data(nrxp) "$data(nrxp) +\[0-9\]+" ;# tx compressed
1784 set first 1
1785 }
1786 while { ![eof $fd] } {
1787 gets $fd line
1788 if { $line == "" } break
1789 if { [regexp $data(nrxp) $line -> iface rxp txp] != 0 &&
1790 [lsearch -exact $data(ifs) $iface] != -1 } {
1791 set ok$iface 1
1792 set rx$iface $rxp
1793 set tx$iface $txp
1794 set prx [ set data(prx$iface) ]
1795 set ptx [ set data(ptx$iface) ]
1796 if { $prx && $ptx } {
1797 set rxdiff [ expr {1.0*($rxp-$prx)} ]
1798 set txdiff [ expr {1.0*($txp-$ptx)} ]
1799 set tot [ expr {$rxdiff+$txdiff} ]
1800 if { $tot > [set total($iface)] } {
1801 set total($iface) $tot
1802 } else {
1803 set tot [set total($iface)]
1804 }
1805 if { !$tot } { set tot 1 }
1806 set rxlen [ expr {($rxdiff/$tot)*$len} ]
1807 set txlen [ expr {($txdiff/$tot)*$len} ]
1808 _$pathName itemconfigure $iface -fill "" -outline ""
1809 foreach { x1 y1 x2 y2 } [ _$pathName coords ${iface}box ] break
1810 if { $rxlen } {
1811 if { $data(-orient) == "vertical" } {
1812 set y1 [ expr {$bot-$rxlen} ]
1813 set y2 $bot
1814 } else {
1815 set x1 [ expr {$left+$rxlen} ]
1816 set x2 $left
1817 }
1818 _$pathName coords rx$iface $x1 $y1 $x2 $y2
1819 _$pathName itemconfigure rx$iface -fill $data(-color1) \
1820 -outline $data(-color1)
1821 }
1822 if { $txlen } {
1823 if { $data(-orient) == "vertical" } {
1824 set y1 [ expr {$bot-$rxlen-$txlen} ]
1825 set y2 [ expr {$bot-$rxlen} ]
1826 } else {
1827 set x1 [ expr {$left+$rxlen+$txlen} ]
1828 set x2 [ expr {$left+$rxlen} ]
1829 }
1830 _$pathName coords tx$iface $x1 $y1 $x2 $y2
1831 _$pathName itemconfigure tx$iface -fill $data(-color2) \
1832 -outline $data(-color2)
1833 }
1834 }
1835 set data(prx$iface) $rxp
1836 set data(ptx$iface) $txp
1837 }
1838 }
1839 close $fd
1840 }
And again after -interval seconds.
1846 set data(afterid) [ after [expr {$data(-interval)*1000}] \
1847 "Meter::UpdateFromProc $pathName" ]
1848 }
Meter::TheDisk()
|
Find out the name of the first hard disk on the system, so we can use '-disk yes' instead of having to know its (OS-dependent) name. At the same time, also determine the disk type (s=SCSI or h=IDE) on Linux, so we don't have to keep looking at /proc/partitions all the time.
|
Parameters
|
None.
|
Returns
|
The disk name, e.g. 'hda' or 'sda' on Linux, 'ad0' on FreeBSD, 'wd0' on OpenBSD. On Linux, the global variable Meter::devtype is also set.
|
1870 proc Meter::TheDisk {} {
1871 set dev ""
1872 if { [file readable /proc/stat] } {
1873 # Linux
1874 set ::Meter::devtype h
1875 set fd [ open /proc/stat r ]
1876 while { ![eof $fd] } {
1877 gets $fd line
1878 if { [regexp {^disk_io: (.*)$} $line -> disks] } {
1879 # Linux 2.4
1880 foreach disk $disks {
1881 regexp {\(([0-9]+),([0-9]+)\).*} $disk -> maj min
1882 switch $maj {
1883 3 {
1884 if { $dev != "" } continue
1885 set dev [ format "hd%c" [expr $min+97] ]
1886 }
1887 22 {
1888 if { $dev != "" } continue
1889 set dev [ format "hd%c" [expr $min+99] ]
1890 }
1891 8 {
1892 set ::Meter::devtype s
1893 set dev [ format "sd%c" [expr $min+97] ]
1894 break
1895 }
1896 }
1897 }
1898 } elseif { [regexp {^disk_rblk .*} $line] } {
1899 # Linux 2.2
1900 set pfd [ open "| grep { sd.} /proc/partitions" r ]
1901 set type h
1902 while { ![eof $pfd] } {
1903 gets $pfd line
1904 if { $line != "" } { set type s }
1905 }
1906 catch { close $pfd }
1907 set dev ${type}da
1908 set ::Meter::devtype $type
1909 }
1910 }
1911 close $fd
1912 } else {
1913 # BSD
1914 set devs [ exec /usr/sbin/iostat -d | head -1 ]
1915 if { [regexp {^[a-z0-9 ]+$} $devs] } {
1916 set dev [ lindex $devs 0 ]
1917 }
1918 }
1919 return $dev
1920 }
1922 set Meter::DefaultDisk [Meter::TheDisk]