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