xbatmon-simple-tray

   1 #!/usr/bin/wish -f
   2 # -*- Tcl -*-
   3
   4 # usage:
   5 #  xbatmon-simple-tray
   6 #    [WISH-OPTIONS... [-- TRAY-EMBED-OPTIONS... [-- XBATMON-SIMPLE-OPTIONS...]]]
   7
   8 source subproc.tcl
   9 source utils.tcl
  10 source args.tcl
  11
  12 proc cmdline {id orientation} {
  13     global argv
  14     return [concat [list xacpi-simple -into $id] $argv]
  15 }
  16
  17 #----- tooltip generation -----
  18
  19 proc tt-invisible {} {
  20     tt-noafter
  21     applet::tooltip-set {}
  22 }
  23
  24 proc tt-noafter {} {
  25     global ttafter
  26     catch { after cancel $ttafter }
  27     catch { unset ttafter }
  28 }
  29
  30 proc tt-show {} {
  31     global ttafter
  32     tt-noafter
  33     set ttafter [after 500 tt-show]
  34     applet::tooltip-set [tt-string]
  35 }
  36
  37 proc append-energies {av energy power eunit punit fmt} {
  38     upvar 1 o o
  39     upvar 1 $av a
  40     append o [format "  ${fmt}%s / ${fmt}%s / ${fmt}%s  ${fmt}%s" \
  41                   [expr { $a(${energy}_NOW)         * 1e-6 }]  $eunit  \
  42                   [expr { $a(${energy}_FULL)        * 1e-6 }]  $eunit  \
  43                   [expr { $a(${energy}_FULL_DESIGN) * 1e-6 }]  $eunit  \
  44                   [expr { $a(${power}_NOW)          * 1e-6 }]  $punit]
  45 }
  46
  47 proc append-percents {qv} {
  48     upvar 1 o o
  49     upvar 1 $qv q
  50     append o [format "  %.0f%% (%.0f%%/%.0f%%)" \
  51                   [expr { $q(energy_NOW)  * 100.0 / $q(energy_FULL_DESIGN) }] \
  52                   [expr { $q(energy_NOW)  * 100.0 / $q(energy_FULL)        }] \
  53                   [expr { $q(energy_FULL) * 100.0 / $q(energy_FULL_DESIGN) }]]
  54     if {$q(power_NOW) < -1} {
  55         set endpoint 0
  56     } elseif {$q(power_NOW) > -1} {
  57         set endpoint $q(energy_FULL)
  58     }
  59     if {[info exists endpoint]} {
  60         set until [expr {($endpoint - $q(energy_NOW)) * 60.0/ $q(power_NOW)}]
  61         if {$until < 72*60} {
  62             append o [format "  %.fmins" $until]
  63         }
  64     }
  65 }
  66
  67 proc tt-string {} {
  68     global errorInfo
  69     set lines {}
  70     if {[catch {
  71         set dir /sys/class/power_supply
  72         foreach f [glob -nocomplain -tails -directory $dir *] {
  73             debug::debug "TT-INFO $f"
  74             if {[catch {
  75                 set chan [open $dir/$f/uevent]
  76                 tt-info $chan
  77             } info]} {
  78                 set info "error: $info"
  79                 debug::debug "$f $errorInfo"
  80             }
  81             lappend lines "$f: $info"
  82             catch { close $chan }
  83             catch { unset chan }
  84         }
  85     } emsg]} {
  86         lappend lines "error scanning: $emsg"
  87         debug::debug "scanning $errorInfo"
  88     }
  89     if {$nbatts} {
  90         set o "Total: $nbatts present  "
  91         append o [join [lsort [array names states]] /]
  92         append-energies tot energy power Wh W %.1f
  93         append-percents tot
  94         lappend lines $o
  95     }
  96     if {![llength $lines]} {
  97         lappend lines "no power information"
  98     }
  99     return [join $lines "\n"]
 100 }
 101
 102 proc compute {power energy factor punit eunit sign fmt} {
 103     upvar 1 a a
 104     upvar 1 q q
 105     upvar 1 tot tot
 106     upvar 1 o o
 107     debug::debug "COMPUTE $power $energy $factor"
 108     set energy_sign 1
 109     set power_sign $sign
 110     set entl {{energy NOW} {energy FULL} {energy FULL_DESIGN} {power NOW}}
 111     foreach ent $entl {
 112         manyset $ent pe k
 113         set kq "${pe}_${k}"
 114         set kv "[set $pe]_$k"
 115         if {![info exists a($kv)]} { return 0 }
 116         set a($kv) [expr {$a($kv) * [set "${pe}_sign"]}]
 117         set q($kq) [expr {$a($kv) * $factor}]
 118     }
 119     debug::debug "COMPUTE OK [array names q]"
 120     foreach ent $entl {
 121         manyset $ent pe k
 122         set kq "${pe}_${k}"
 123         if {![info exists tot($kq)]} { set tot($kq) 0 }
 124         set tot($kq) [expr {$tot($kq) + $q($kq)}]
 125     }
 126     append-energies a $energy $power $eunit $punit $fmt
 127     append-percents q
 128     return 1
 129 }
 130
 131 proc tt-info {chan} {
 132     upvar 1 tot tot
 133     upvar 1 nbatts nbatts
 134     upvar 1 states states
 135     while {[gets $chan l] >= 0} {
 136         if {[regexp {^POWER_SUPPLY_([A-Z0-9_]+)=(.*)$} $l dummy k v]} {
 137             debug::debug "  uevent ok  $l"
 138             set a($k) $v
 139         } else {
 140             debug::debug "  uevent unk $l"
 141         }
 142     }
 143     debug::debug "GOT [array names a]"
 144     set o "$a(TYPE)"
 145     set nbatts 0
 146     switch -exact -- $a(TYPE) {
 147         Mains {
 148             switch -exact -- $a(ONLINE) {
 149                 0 { append o " Offline" }
 150                 1 { append o " Online" }
 151                 default { append o " ?$o" }
 152             }
 153         }
 154         Battery {
 155             switch -exact -- $a(PRESENT) {
 156                 0 { append o " Absent"; return $o }
 157                 1 { append o " Present" }
 158                 default { apend o " ?$o" }
 159             }
 160             set sign 1
 161             append o " "
 162             switch -exact -- $a(STATUS) {
 163                 Charging { }
 164                 Discharging { set sign -1 }
 165                 default { append o "Status=" }
 166             }
 167             set states($a(STATUS)) 1
 168             append o $a(STATUS)
 169             foreach power {POWER CURRENT} energy {ENERGY CHARGE} \
 170                     punit {W A} eunit {Wh Ah} fmt {%.1f %.2f} {
 171                 switch -exact $power {
 172                     POWER { set factor 1.0 }
 173                     CURRENT { set factor [expr {$a(VOLTAGE_NOW) * 1e-6}] }
 174                 }
 175                 if {![compute $power $energy $factor \
 176                               $punit $eunit $sign $fmt]} continue
 177                 incr nbatts
 178             }
 179         }
 180     }
 181     return $o
 182 }
 183
 184 #----- modes -----
 185
 186 proc mode/normal {} {
 187     uplevel #0 source applet.tcl
 188     applet::setup-subproc cmdline
 189     applet::setup-tooltip tt-show tt-invisible
 190 }
 191
 192 proc mode/-tooltip-string {} {
 193     puts [tt-string]
 194     exit 0
 195 }
 196
 197 #----- command line parsing -----
 198
 199 set mode normal
 200
 201 while {[args::next_special arg]} {
 202     switch -exact -- $arg {
 203         -- { break }
 204         -tooltip-string { set mode $arg }
 205         default { args::badoption }
 206     }
 207 }
 208
 209 mode/$mode