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