4 # Copyright 2016,2020 Ian Jackson
5 # SPDX-License-Identifier: GPL-3.0-or-later
6 # There is NO WARRANTY.
10 # [WISH-OPTIONS... [-- TRAY-EMBED-OPTIONS... [-- XBATMON-SIMPLE-OPTIONS...]]]
14 source $lib/subproc.tcl
17 source $lib/applet.tcl
19 proc cmdline {id orientation} {
21 return [concat [list xacpi-simple -into $id] $argv]
24 #----- tooltip generation -----
26 proc tt-invisible {} {
28 applet::tooltip-set {}
33 catch { after cancel $ttafter }
34 catch { unset ttafter }
40 set ttafter [after 500 tt-show]
41 applet::tooltip-set [tt-string]
44 proc append-energies {av energy power eunit punit fmt} {
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]
54 proc append-percents {qv} {
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} {
63 } elseif {$q(power_NOW) > -1} {
64 set endpoint $q(energy_FULL)
66 if {[info exists endpoint]} {
67 set until [expr {($endpoint - $q(energy_NOW)) * 60.0/ $q(power_NOW)}]
69 append o [format " %.fmins" $until]
78 set dir /sys/class/power_supply
79 foreach f [glob -nocomplain -tails -directory $dir *] {
80 debug::debug "TT-INFO $f"
82 set chan [open $dir/$f/uevent]
85 set info "error: $info"
86 debug::debug "$f $errorInfo"
88 lappend lines "$f: $info"
93 lappend lines "error scanning: $emsg"
94 debug::debug "scanning $errorInfo"
97 set o "Total: $nbatts present "
98 append o [join [lsort [array names states]] /]
99 append-energies tot energy power Wh W %.1f
103 if {![llength $lines]} {
104 lappend lines "no power information"
106 return [join $lines "\n"]
109 proc compute {power energy factor punit eunit sign fmt} {
114 debug::debug "COMPUTE $power $energy $factor"
117 set entl {{energy NOW} {energy FULL} {energy FULL_DESIGN} {power NOW}}
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}]
126 debug::debug "COMPUTE OK [array names q]"
130 if {![info exists tot($kq)]} { set tot($kq) 0 }
131 set tot($kq) [expr {$tot($kq) + $q($kq)}]
133 append-energies a $energy $power $eunit $punit $fmt
138 proc tt-info {chan} {
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"
147 debug::debug " uevent unk $l"
150 debug::debug "GOT [array names a]"
151 if {![info exists a(TYPE)]} {
153 foreach k {ONLINE PRESENT} { append op [info exists a($k)] }
155 10 { set a(TYPE) Mains }
156 01 { set a(TYPE) Battery }
157 default { error "no type and bad op $op" }
159 debug::debug " guessed type $a(TYPE) from ONLINE PRESENT $op"
164 switch -exact -- $a(TYPE) {
166 switch -exact -- $a(ONLINE) {
167 0 { append o " Offline" }
168 1 { append o " Online" }
169 default { append o " ?$o" }
173 switch -exact -- $a(PRESENT) {
174 0 { append o " Absent"; return $o }
175 1 { append o " Present" }
176 default { apend o " ?$o" }
180 switch -exact -- $a(STATUS) {
182 Discharging { set sign -1 }
183 default { append o "Status=" }
185 set states($a(STATUS)) 1
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}] }
193 if {![compute $power $energy $factor \
194 $punit $eunit $sign $fmt]} continue
204 proc mode/normal {} {
205 uplevel #0 { applet::become }
206 applet::setup-subproc cmdline
207 applet::setup-tooltip tt-show tt-invisible
210 proc mode/-tooltip-string {} {
215 #----- command line parsing -----
218 set usersettings $env(HOME)/.config/xbatmon-simple-tray
220 while {[args::next_special arg]} {
221 switch -exact -- $arg {
223 -tooltip-string { set mode $arg }
224 default { args::badoption }
228 if {[file exists $usersettings]} {