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     if {![info exists a(TYPE)]} {
 145         set op {}
 146         foreach k {ONLINE PRESENT} { append op [info exists a($k)] }
 147         switch -exact $op {
 148             10 { set a(TYPE) Mains }
 149             01 { set a(TYPE) Battery }
 150             default { error "no type and bad op $op" }
 151         }
 152         debug::debug "  guessed type $a(TYPE) from ONLINE PRESENT $op"
 153     }
 154     set o "$a(TYPE)"
 155
 156     set nbatts 0
 157     switch -exact -- $a(TYPE) {
 158         Mains {
 159             switch -exact -- $a(ONLINE) {
 160                 0 { append o " Offline" }
 161                 1 { append o " Online" }
 162                 default { append o " ?$o" }
 163             }
 164         }
 165         Battery {
 166             switch -exact -- $a(PRESENT) {
 167                 0 { append o " Absent"; return $o }
 168                 1 { append o " Present" }
 169                 default { apend o " ?$o" }
 170             }
 171             set sign 1
 172             append o " "
 173             switch -exact -- $a(STATUS) {
 174                 Charging { }
 175                 Discharging { set sign -1 }
 176                 default { append o "Status=" }
 177             }
 178             set states($a(STATUS)) 1
 179             append o $a(STATUS)
 180             foreach power {POWER CURRENT} energy {ENERGY CHARGE} \
 181                     punit {W A} eunit {Wh Ah} fmt {%.1f %.2f} {
 182                 switch -exact $power {
 183                     POWER { set factor 1.0 }
 184                     CURRENT { set factor [expr {$a(VOLTAGE_NOW) * 1e-6}] }
 185                 }
 186                 if {![compute $power $energy $factor \
 187                               $punit $eunit $sign $fmt]} continue
 188                 incr nbatts
 189             }
 190         }
 191     }
 192     return $o
 193 }
 194
 195 #----- modes -----
 196
 197 proc mode/normal {} {
 198     uplevel #0 source applet.tcl
 199     applet::setup-subproc cmdline
 200     applet::setup-tooltip tt-show tt-invisible
 201 }
 202
 203 proc mode/-tooltip-string {} {
 204     puts [tt-string]
 205     exit 0
 206 }
 207
 208 #----- command line parsing -----
 209
 210 set mode normal
 211
 212 while {[args::next_special arg]} {
 213     switch -exact -- $arg {
 214         -- { break }
 215         -tooltip-string { set mode $arg }
 216         default { args::badoption }
 217     }
 218 }
 219
 220 mode/$mode