xbatmon-simple-tray

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