chiark / gitweb /
does some tooltips
[chiark-tcl-applet.git] / 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} {
38     upvar 1 o o
39     upvar 1 $av a
40     append o [format "  %.0f%s / %.0f%s / %.0f%s  %.0f%s" \
41                   [expr { $a(${energy}_NOW)         * 1e-3 }]  $eunit  \
42                   [expr { $a(${energy}_FULL)        * 1e-3 }]  $eunit  \
43                   [expr { $a(${energy}_FULL_DESIGN) * 1e-3 }]  $eunit  \
44                   [expr { $a(${power}_NOW)          * 1e-3 }]  $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 mWh mW
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} {
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
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     set o "$a(TYPE)"
145     set nbatts 0
146     switch -exact -- $a(TYPE) {
147         Mains {
148             switch -exact -- $a(ONLINE) {
149                 0 { append o " Offline" }
150                 1 { append o " Online" }
151                 default { append o " ?$o" }
152             }
153         }
154         Battery {
155             switch -exact -- $a(PRESENT) {
156                 0 { append o " Absent"; return $o }
157                 1 { append o " Present" }
158                 default { apend o " ?$o" }
159             }
160             set sign 1
161             append o " "
162             switch -exact -- $a(STATUS) {
163                 Charging { }
164                 Discharging { set sign -1 }
165                 default { append o "Status=" }
166             }
167             set states($a(STATUS)) 1
168             append o $a(STATUS)
169             foreach power {POWER CURRENT} energy {ENERGY CHARGE} \
170                     punit {mW mA} eunit {mWh mAh} {
171                 switch -exact $power {
172                     POWER { set factor 1.0 }
173                     CURRENT { set factor [expr {$a(VOLTAGE_NOW) * 1e-6}] }
174                 }
175                 if {![compute $power $energy $factor $punit $eunit $sign]} \
176                     continue
177                 incr nbatts
178             }
179         }
180     }
181     return $o
182 }
183
184 #----- modes -----
185
186 proc mode/normal {} {
187     uplevel #0 source applet.tcl
188     applet::setup-subproc cmdline
189     applet::setup-tooltip tt-show tt-invisible
190 }
191
192 proc mode/-tooltip-string {} {
193     puts [tt-string]
194     exit 0
195 }
196
197 #----- command line parsing -----
198
199 set mode normal
200
201 while {[args::next_special arg]} {
202     switch -exact -- $arg {
203         -- { break }
204         -tooltip-string { set mode $arg }
205         default { args::badoption }
206     }
207 }
208
209 mode/$mode