From a28043c357ce68cd1d1dd17abc81e39cc7f7b84a Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Tue, 12 Jun 2012 18:04:46 +0100 Subject: [PATCH] reorganise debug etc. --- applet.tcl | 51 +++++-------------- args.tcl | 2 +- subproc.tcl | 2 + xbatmon-simple-tray | 118 +++++++++++++++++++++++++++++++++++++++++++- 4 files changed, 131 insertions(+), 42 deletions(-) diff --git a/applet.tcl b/applet.tcl index 133eb13..0aa2b94 100644 --- a/applet.tcl +++ b/applet.tcl @@ -1,13 +1,5 @@ # General purpose code for being a tray applet -proc manyset {list args} { - foreach val $list var $args { - upvar 1 $var my - set my $val - } -} - - package require Tclx package require tktray @@ -41,13 +33,6 @@ package require tktray # menus, when an item is selected, call # applet::msel # -# Debug: -# -# Caller may call -# applet::setup-debug ON-DEBUG -# which will result in calls to [concat ON-DEBUG [list MESSAGE]] -# (or ON-DEBUG may be "" in which case messages are discarded) -# # Icon: # # Caller should call: @@ -90,18 +75,6 @@ fconfigure stderr -buffering none namespace eval applet { -variable debug {} - -proc debug {m} { - variable debug - if {![llength $debug]} return - uplevel #0 $debug [list $m] -} - -proc setup-debug {d} { - variable debug $d -} - # used by both menus and tooltips variable posted 0 @@ -116,15 +89,15 @@ proc menubuttonpressed {b x y} { variable posted tooltip-cancel if {$posted == $b} { - debug "unpost $posted toggle" + debug::debug "unpost $posted toggle" .m$posted unpost set posted 0 } elseif {[winfo exists .m$b]} { if {$posted} { .m$posted unpost - debug "unpost $posted other" + debug::debug "unpost $posted other" } - debug "post $b" + debug::debug "post $b" set posted $b .m$b post $x $y } @@ -223,7 +196,7 @@ variable border_width 1 proc subwindow-need-recreate {} { variable innerwindow_after - debug "IW-EVENT" + debug::debug "IW-EVENT" if {[info exists innerwindow_after]} return set innerwindow_after [after idle applet::innerwindow-resetup] } @@ -237,7 +210,7 @@ proc innerwindow-resetup {} { variable deforient unset innerwindow_after - debug RESETUP + debug::debug RESETUP if {![winfo exists .i.i]} return destroy [frame .i.i.make-exist] @@ -246,7 +219,7 @@ proc innerwindow-resetup {} { catch { destroy .i.i.b } set orientation [.i orientation] - debug "orientation $orientation" + debug::debug "orientation $orientation" if {![string compare $orientation unknown]} { set orientation $deforient } @@ -289,7 +262,7 @@ proc setup-subproc {get_cmdline} { proc subproc-destroying {} { variable subproc - debug "DESTROYING $subproc" + debug::debug "DESTROYING $subproc" catch { destroy .i.i.b.c } @@ -303,7 +276,7 @@ proc subproc-destroying {} { proc subproc-ready {orientation} { variable subproc variable subproc_orientation $orientation - debug "READY $subproc" + debug::debug "READY $subproc" frame .i.i.b.c -container 1 -background orange pack .i.i.b.c -fill both -side left -expand 1 @@ -319,7 +292,7 @@ proc subproc-ready {orientation} { error "unexpected state $subproc" } } - debug "READY-done $subproc" + debug::debug "READY-done $subproc" } proc run-child {} { @@ -331,7 +304,7 @@ proc run-child {} { set id [winfo id .i.i.b.c] set cmd [uplevel #0 $subproc_get_cmdline [list $id $subproc_orientation]] - debug "RUN-CHILD $subproc" + debug::debug "RUN-CHILD $subproc" set now [clock seconds] lappend ratelimit $now while {[lindex $ratelimit 0] < {$now - 10}} { @@ -346,11 +319,11 @@ proc run-child {} { set subproc [subproc::fork applet::child-died { execl [lindex $cmd 0] [lrange $cmd 1 end] }] - debug "FORKED $subproc" + debug::debug "FORKED $subproc" } proc child-died {how how2} { - debug "DIED $how $how2" + debug::debug "DIED $how $how2" variable subproc switch -exact $subproc { old { diff --git a/args.tcl b/args.tcl index 248548b..c81118c 100644 --- a/args.tcl +++ b/args.tcl @@ -35,7 +35,7 @@ proc generalarg {arg} { -horizontal - -vertical { set applet::deforient $arg } -borderColour - -borderColor { set applet::border_colour [next] } -borderWidth { set applet::border_width [next_num] } - -debug { applet::setup-debug puts } + -debug { debug::setup puts } default { return 0 } } return 1 diff --git a/subproc.tcl b/subproc.tcl index 36d5465..c4cf975 100644 --- a/subproc.tcl +++ b/subproc.tcl @@ -1,4 +1,6 @@ +package require Tclx + namespace eval subproc { #----- general purpose subprocess handling ----- diff --git a/xbatmon-simple-tray b/xbatmon-simple-tray index e53945a..2a3948c 100755 --- a/xbatmon-simple-tray +++ b/xbatmon-simple-tray @@ -5,8 +5,8 @@ # xbatmon-simple-tray # [WISH-OPTIONS... [-- TRAY-EMBED-OPTIONS... [-- XBATMON-SIMPLE-OPTIONS...]]] -source applet.tcl source subproc.tcl +source utils.tcl source args.tcl proc cmdline {id orientation} { @@ -14,11 +14,125 @@ proc cmdline {id orientation} { return [concat [list xacpi-simple -into $id] $argv] } +#----- tooltip generation ----- + +proc tt-invisible {} { + tt-noafter + applet::tooltip-set {} +} + +proc tt-noafter {} { + global ttafter + catch { after cancel $ttafter } + catch { unset ttafter } +} + +proc tt-show {} { + global ttafter + tt-noafter + set ttafter [after 500 tt-show] + applet::tooltip-set [tt-string] +} + +proc tt-string {} { + global errorInfo + set lines {} + if {[catch { + set dir /sys/class/power_supply + foreach f [glob -nocomplain -tails -directory $dir *] { + debug::debug "TT-INFO $f" + if {[catch { + set chan [open $dir/$f/uevent] + tt-info $chan + } info]} { + set info "error: $info" + debug::debug "$f $errorInfo" + } + lappend lines "$f: $info" + catch { close $chan } + catch { unset chan } + } + } emsg]} { + lappend lines "error scanning: $emsg" + debug::debug "scanning $errorInfo" + } + if {![llength $lines]} { + lappend lines "no power information" + } + return [join $lines "\n"] +} + +proc compute {power energy factor} { + upvar 1 a a + upvar 1 q q + debug::debug "COMPUTE $power $energy $factor" + foreach ent {energy NOW} {energy FULL} {energy FULL_DESIGN} {power NOW} { + manyset $ent pe k + set kv "[set $pe]_$k" + if {![info exists a($kv)]} { return 0 } + set q("${pe}_${k}") [expr {$a($kv) * $factor}] + } + return 1 +} + +proc tt-info {chan} { + while {[gets $chan l] >= 0} { + if {[regexp {^POWER_SUPPLY_([A-Z0-9_]+)=(.*)$} $l dummy k v]} { + debug::debug " uevent ok $l" + set a($k) $v + } else { + debug::debug " uevent unk $l" + } + } + set o "$a(TYPE)" + switch -exact -- $a(TYPE) { + Mains { + switch -exact -- $a(ONLINE) { + 0 { append o " Offline" } + 1 { append o " Online" } + default { append o " ?$o" } + } + } + Battery { + switch -exact -- $a(PRESENT) { + 0 { append o " Absent"; return $o } + 1 { append o " Present" } + default { apend o " ?$o" } + } + append o " $a(STATUS)" + if {[compute POWER ENERGY 1.0] || + [compute CURRENT CHARGE [expr {$a(VOLTAGE_NOW) * 1e-6}]]} { + debug::debug "COMPUTE OK" + } else { + append o " ?" + } + } + } +} + +#----- modes ----- + +proc mode/normal {} { + uplevel #0 source applet.tcl + applet::setup-subproc cmdline + applet::setup-tooltip tt-show tt-invisible +} + +proc mode/-tooltip-string {} { + puts [tt-string] + exit 0 +} + +#----- command line parsing ----- + +set mode normal + while {[args::next_special arg]} { switch -exact -- $arg { -- { break } + -tooltip-string { set mode $arg } default { args::badoption } } } -applet::setup-subproc cmdline +mode/$mode -- 2.30.2