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 tt-string {} {
  38     global errorInfo
  39     set lines {}
  40     if {[catch {
  41         set dir /sys/class/power_supply
  42         foreach f [glob -nocomplain -tails -directory $dir *] {
  43             debug::debug "TT-INFO $f"
  44             if {[catch {
  45                 set chan [open $dir/$f/uevent]
  46                 tt-info $chan
  47             } info]} {
  48                 set info "error: $info"
  49                 debug::debug "$f $errorInfo"
  50             }
  51             lappend lines "$f: $info"
  52             catch { close $chan }
  53             catch { unset chan }
  54         }
  55     } emsg]} {
  56         lappend lines "error scanning: $emsg"
  57         debug::debug "scanning $errorInfo"
  58     }
  59     if {![llength $lines]} {
  60         lappend lines "no power information"
  61     }
  62     return [join $lines "\n"]
  63 }
  64
  65 proc compute {power energy factor} {
  66     upvar 1 a a
  67     upvar 1 q q
  68     debug::debug "COMPUTE $power $energy $factor"
  69     foreach ent {energy NOW} {energy FULL} {energy FULL_DESIGN} {power NOW} {
  70         manyset $ent pe k
  71         set kv "[set $pe]_$k"
  72         if {![info exists a($kv)]} { return 0 }
  73         set q("${pe}_${k}") [expr {$a($kv) * $factor}]
  74     }
  75     return 1
  76 }
  77
  78 proc tt-info {chan} {
  79     while {[gets $chan l] >= 0} {
  80         if {[regexp {^POWER_SUPPLY_([A-Z0-9_]+)=(.*)$} $l dummy k v]} {
  81             debug::debug "  uevent ok  $l"
  82             set a($k) $v
  83         } else {
  84             debug::debug "  uevent unk $l"
  85         }
  86     }
  87     set o "$a(TYPE)"
  88     switch -exact -- $a(TYPE) {
  89         Mains {
  90             switch -exact -- $a(ONLINE) {
  91                 0 { append o " Offline" }
  92                 1 { append o " Online" }
  93                 default { append o " ?$o" }
  94             }
  95         }
  96         Battery {
  97             switch -exact -- $a(PRESENT) {
  98                 0 { append o " Absent"; return $o }
  99                 1 { append o " Present" }
 100                 default { apend o " ?$o" }
 101             }
 102             append o " $a(STATUS)"
 103             if {[compute POWER ENERGY 1.0] ||
 104                 [compute CURRENT CHARGE [expr {$a(VOLTAGE_NOW) * 1e-6}]]} {
 105                 debug::debug "COMPUTE OK"
 106             } else {
 107                 append o " ?"
 108             }
 109         }
 110     }
 111 }
 112
 113 #----- modes -----
 114
 115 proc mode/normal {} {
 116     uplevel #0 source applet.tcl
 117     applet::setup-subproc cmdline
 118     applet::setup-tooltip tt-show tt-invisible
 119 }
 120
 121 proc mode/-tooltip-string {} {
 122     puts [tt-string]
 123     exit 0
 124 }
 125
 126 #----- command line parsing -----
 127
 128 set mode normal
 129
 130 while {[args::next_special arg]} {
 131     switch -exact -- $arg {
 132         -- { break }
 133         -tooltip-string { set mode $arg }
 134         default { args::badoption }
 135     }
 136 }
 137
 138 mode/$mode