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