#!/bin/sh
#
# i8kmon -- Monitor cpu temperature and fan status on Dell Inspiron laptops.
#	    The program can be run in background as daemon or under X as an
#	    applet swallowed in the gnome panel.
#
# Copyright (C) 2001-2005  Massimo Dal Zotto <dz@debian.org>
#
# This program is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 2, or (at your option) any
# later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
#\
exec tclsh $0 -- "$@"

#\
MAKE_LINTIAN_HAPPY '

set PROG_VERSION "v1.27 17/06/2005"

array set config {
    sysconfig	/etc/i8kmon
    userconfig	~/.i8kmon
    proc_i8k	/proc/i8k
    proc_apm	/proc/apm
    proc_ac24	/proc/acpi/ac_adapter/0/status
    proc_ac26	/proc/acpi/ac_adapter/AC/state
    i8kfan	/usr/bin/i8kfan
    geometry	{}
    auto	0
    daemon	0
    verbose	0
    timeout	5
    unit	C
    t_high	80
    min_speed	2000
    0		{{0 0}  -1  60  -1  65}
    1		{{1 0}  50  70  55  75}
    2		{{1 1}  60  80  65  85}
    3		{{2 2}  70 128  75 128}
}

array set status {
    left	{}
    right	{}
    timer	{}
    nfans	2
    apm_timer	0
    state	0
    temp	0
    lstate	0
    rstate	0
    lspeed	0
    rspeed	0
    lstuck	0
    rstuck	0
    ac		0
    t_low	0
    t_high	0
    ui		0
    suspend	0
}

proc read_config {} {
    global config
    global status

    # I8000 A17 BIOS defaults:
    # array set defaults {
    #	0	{{0 0}  -1  76  -1  76}
    #	1	{{1 0}  67  82  67  82}
    #	2	{{1 1}  70  87  70  87}
    #	3	{{2 2}  75 128  75 128}
    # }

    array set defaults {
	0	{{0 0}  -1  60  -1  65}
	1	{{1 0}  50  70  55  75}
	2	{{1 1}  60  80  65  85}
	3	{{2 2}  70 128  75 128}
    }

    foreach file [list $config(sysconfig) $config(userconfig)] {
	if {[file exists $file]} {
	    if {$config(verbose) != 0} {
		puts "# reading $file"
	    }
	    source $file
	}
    }

    set t_high 0
    foreach key {0 1 2 3} {
	if {![info exists config($key)]} {
	    set config($key) $defaults($key)
	}
	set fans  [lindex $config($key) 0]
	set lo_ac [lindex $config($key) 1]
	set hi_ac [lindex $config($key) 2]
	set lo_bt [lindex $config($key) 3]
	set hi_bt [lindex $config($key) 4]
	if {$hi_bt == {}} { set hi_bt [expr $hi_ac + 5] }
	if {$lo_bt == {}} { set lo_bt [expr $lo_ac +10] }
	if {$hi_ac < 128 && $hi_ac > $t_high} { set t_high $hi_ac }
	if {$hi_bt < 128 && $hi_bt > $t_high} { set t_high $hi_bt }
	set config($key) [list $fans $lo_ac $hi_ac $lo_bt $hi_bt]
    }
    if {$config(t_high) == {} || $config(t_high) == 0} {
	set config(t_high) $t_high
    }
    set status(t_high) [lindex $config(0) 1]
}

proc status_timer {} {
    global config
    global status

    # Reschedule status timer
    catch {after cancel $status(timer)}
    set status(timer) [after [expr $config(timeout)*1000] {status_timer}]

    check_status
}

proc check_status {} {
    global config
    global status

    if {$status(suspend) == 1} {
	close_procfs
	return
    }

    if {![read_i8k_status]} {
	return
    }

    if {$config(auto) == 1} {
	fan_control
    }

    if {$status(ui) == 1} {
	update_ui
    }
}

proc read_i8k_status {} {
    global config
    global status

    if {![info exists status(proc_i8k)] && ![open_proc_i8k]} {
	return 0
    }

    set info [seek $status(proc_i8k) 0; read -nonewline $status(proc_i8k)]
    # Uncomment to force high temp or one fan for debugging:
    # set info [lreplace $info 3 3 80]
    # set info [lreplace $info 5 5 -22]; set info [lreplace $info 7 7 -22]
    # Undo kernel computation 30*speed if speed seems too high.
    if {[lindex $info 6] > 20000} {
	set info [lreplace $info 6 6 [expr [lindex $info 6]/30]]
    }
    if {[lindex $info 7] > 20000} {
	set info [lreplace $info 7 7 [expr [lindex $info 7]/30]]
    }

    set status(temp)   [lindex $info 3]
    set status(lstate) [lindex $info 4]
    set status(rstate) [lindex $info 5]
    set status(lspeed) [lindex $info 6]
    set status(rspeed) [lindex $info 7]

    # If AC status is not available read it from procfs
    if {[set ac [lindex $info 8]] >= 0} {
	set status(ac) $ac
    } else {
	read_ac_status
    }

    # Done in make_ui.
    # If second fan status is not available assume we have only a fan
    #if {$status(nfans) >= 2 && $status(lstate) >= 0 && $status(rstate) < 0} {
    #	set status(nfans) 1
    #	catch {
    #	    place forget .i8kmon.rfan
    #	    place .i8kmon.lfan -relx 0.0 -rely 0.5 -relwidth 1.0 -relheight 0.5
    #	}
    #}

    # If fan speed is not available (on I4000) assume fans are running
    if {$status(lspeed) < 0} { set status(lspeed) $config(min_speed) }
    if {$status(rspeed) < 0} { set status(rspeed) $config(min_speed) }

    if {$config(verbose) > 0} {
	set info [lreplace $info 8 8 $status(ac)]
	puts "[clock seconds] $info"
    }

    return 1
}

proc read_ac_status {} {
    global config
    global status

    # Read ac status once per minute
    if {[incr status(apm_timer) -1] > 0} {
	return 1
    }
    set status(apm_timer) [expr 60 / $config(timeout)]

    if {[info exists status(proc_apm)] || [file exists $config(proc_apm)]} {
	if {[read_apm_status]} return
    }
    if {[info exists status(proc_ac24)] || [file exists $config(proc_ac24)]} {
	if {[read_ac24_status]} return
    }
    if {[info exists status(proc_ac26)] || [file exists $config(proc_ac26)]} {
	if {[read_ac26_status]} return
    }
    return 0
}

proc read_apm_status {} {
    global config
    global status

    if {![info exists status(proc_apm)] && ![open_proc_apm]} {
	return 0
    }

    set info [seek $status(proc_apm) 0; read -nonewline $status(proc_apm)]
    if {[lindex $info 3] == "0x01"} {
	set status(ac) 1
    } else {
	set status(ac) 0
    }

    if {$config(verbose) > 0} {
	puts "[clock seconds] apm: $info"
    }

    return 1
}

proc read_ac24_status {} {
    global config
    global status

    if {![info exists status(proc_ac24)] && ![open_proc_ac24]} {
	return 0
    }

    set info [seek $status(proc_ac24) 0; read -nonewline $status(proc_ac24)]
    if {[lindex $info 1] == "on-line"} {
	set status(ac) 1
    } else {
	set status(ac) 0
    }

    if {$config(verbose) > 0} {
	puts "[clock seconds] acpi: $info"
    }

    return 1
}

proc read_ac26_status {} {
    global config
    global status

    if {![info exists status(proc_ac26)] && ![open_proc_ac26]} {
	return 0
    }

    set info [seek $status(proc_ac26) 0; read -nonewline $status(proc_ac26)]
    if {[lindex $info 1] == "on-line"} {
	set status(ac) 1
    } else {
	set status(ac) 0
    }

    if {$config(verbose) > 0} {
	puts "[clock seconds] acpi: $info"
    }

    return 1
}

proc open_proc_i8k {} {
    global config
    global status

    if {$config(verbose) > 0} {
	puts "[clock seconds] opening $config(proc_i8k)"
    }

    if {[catch {set status(proc_i8k) [open $config(proc_i8k)]}]} {
	return 0
    }

    if {[catch {set info [read -nonewline $status(proc_i8k)]}]} {
	close $status(proc_i8k); unset status(proc_i8k)
	return 0
    }

    if {[lindex $info 0] != "1.0" || [llength $info] < 10} {
	close $status(proc_i8k); unset status(proc_i8k)
	return 0
    }

    return 1
}

proc open_proc_apm {} {
    global config
    global status

    if {$config(verbose) > 0} {
	puts "[clock seconds] opening $config(proc_apm)"
    }

    if {[catch {set status(proc_apm) [open $config(proc_apm)]}]} {
	return 0
    }

    if {[catch {set info [read -nonewline $status(proc_apm)]}]} {
	close $status(proc_apm); unset status(proc_apm)
	return 0
    }

    if {[llength $info] < 9} {
	close $status(proc_apm); unset status(proc_apm)
	return 0
    }

    return 1
}

proc open_proc_ac24 {} {
    global config
    global status

    if {$config(verbose) > 0} {
	puts "[clock seconds] opening $config(proc_ac24)"
    }

    if {[catch {set status(proc_ac24) [open $config(proc_ac24)]}]} {
	return 0
    }

    if {[catch {set info [read -nonewline $status(proc_ac24)]}]} {
	close $status(proc_ac24); unset status(proc_ac24)
	return 0
    }

    return 1
}

proc open_proc_ac26 {} {
    global config
    global status

    if {$config(verbose) > 0} {
	puts "[clock seconds] opening $config(proc_ac26)"
    }

    if {[catch {set status(proc_ac26) [open $config(proc_ac26)]}]} {
	return 0
    }

    if {[catch {set info [read -nonewline $status(proc_ac26)]}]} {
	close $status(proc_ac26); unset status(proc_ac26)
	return 0
    }

    return 1
}

proc close_procfs {} {
    global status

    if {[info exists status(proc_i8k)]} {
	catch {close $status(proc_i8k)}
	unset status(proc_i8k)
    }
    if {[info exists status(proc_apm)]} {
	catch {close $status(proc_apm)}
	unset status(proc_apm)
    }
    if {[info exists status(proc_ac24)]} {
	catch {close $status(proc_ac24)}
	unset status(proc_ac24)
    }
    if {[info exists status(proc_ac26)]} {
	catch {close $status(proc_ac26)}
	unset status(proc_ac26)
    }
}

# Automatic fan control
#
#    0	{{0 0}  -1  60  -1  65 }
#    1	{{1 0}  50  70  55  75 }
#    2	{{1 1}  60  80  65  85 }
#    3	{{2 2}  70 128  75 128 }
#
proc fan_control {} {
    global config
    global status

    set index [expr $status(ac) ? 1 : 3]
    set state $status(state)
    set temp  $status(temp)

    while {$temp < 128 && $temp >= $status(t_high)} {
	if {$config(verbose) > 0} {
	    puts -nonewline "# ($temp>=$status(t_high)), "
	}
	incr state
	set status(t_low)  [lindex $config($state) $index]
	set status(t_high) [lindex $config($state) [expr $index+1]]
	if {$config(verbose) > 0} {
	    puts "state=$state, low=$status(t_low), high=$status(t_high)"
	}
    }

    while {$temp > 0 && $temp <= $status(t_low)} {
	if {$config(verbose) > 0} {
	    puts -nonewline "# ($temp<=$status(t_low)), "
	}
	incr state -1
	set status(t_low)  [lindex $config($state) $index]
	set status(t_high) [lindex $config($state) [expr $index+1]]
	if {$config(verbose) > 0} {
	    puts "state=$state, low=$status(t_low), high=$status(t_high)"
	}
    }

    set_fan $state
}

proc set_fan {{state {}}} {
    global config
    global status

    if {$state != {}} {
	set status(state) $state
    }
    set args [lindex $config($status(state)) 0]

    # Default to user settings
    set left  $status(left)
    set right $status(right)

    if {$left == {} && $status(lstate) != [lindex $args 0]} {
	set left [lindex $args 0]
    }
    if {$left != {} && $left < [lindex $args 0]} {
	set left [lindex $args 0]
    }
    if {$left == $status(lstate)} {
	set left {}
    }

    if {$right == {} && $status(rstate) != [lindex $args 1]} {
	set right [lindex $args 1]
    }
    if {$right != {} && $right < [lindex $args 1]} {
	set right [lindex $args 1]
    }
    if {$right == $status(rstate)} {
	set right {}
    }
    if {$status(nfans) < 2} { set right {} }

    if {$left != {} || $right != {}} {
	i8kfan $left $right
    }
}

# Run the external i8kfan command and update fan state
proc i8kfan {args} {
    global config
    global status

    if {$args == {- -}} return

    set cmd [linsert $args 0 exec $config(i8kfan)]
    if {$config(verbose) > 0} {
	puts "# $cmd"
    }

    set result [eval $cmd]
    set status(lstate) [lindex $result 0]
    set status(rstate) [lindex $result 1]

    if {$status(lstate) < 0} { set status(lstate) 0 }
    if {$status(rstate) < 0} { set status(rstate) 0 }
}

proc make_ui {} {
    global status
    global config
    global tcl_version

    if {$config(daemon) == 1} {
	# Daemon mode, no user interface
	return
    }
    if {[info command .i8kmon] != {}} {
	# Applet aready existing
	return
    }

    # Load Tk library (require a Tk version compatible with Tcl)
    package require Tk $tcl_version
    wm title . {}
    wm withdraw .
    update

    toplevel .i8kmon -class I8kmon -relief sunken -bd 1
    wm title .i8kmon i8kmon
    wm command .i8kmon i8kmon
    wm protocol .i8kmon WM_DELETE_WINDOW { exit }

    if {$config(geometry) != {}} {
	set geometry $config(geometry)
    } else {
	set geometry 24x24
    }
    if {[lindex [split $geometry x] 1] >= 36} {
	set font fixed
    } else {
	set font 6x10
    }
    wm geometry .i8kmon $geometry

    label .i8kmon.temp -bd 0 -padx 0 -pady 0 -text "0" -font $font \
	    -highlightthickness 0 -width 3
    button .i8kmon.lfan -bd 1 -padx 0 -pady 0 -text {} -font $font \
	    -highlightthickness 0 -command {toggle_fan left}
    button .i8kmon.rfan -bd 1 -padx 0 -pady 0 -text {} -font $font \
	    -highlightthickness 0 -command {toggle_fan right}
    bind .i8kmon.lfan <Button-2> {toggle_fan left 2}
    bind .i8kmon.lfan <Button-3> {toggle_fan left 0}
    bind .i8kmon.rfan <Button-2> {toggle_fan right 2}
    bind .i8kmon.rfan <Button-3> {toggle_fan right 0}

    place .i8kmon.temp -relx 0.0 -rely 0.0 -relwidth 1.0 -relheight 0.5
    place .i8kmon.lfan -relx 0.0 -rely 0.5 -relwidth 0.5 -relheight 0.5
    place .i8kmon.rfan -relx 0.5 -rely 0.5 -relwidth 0.5 -relheight 0.5

    # Read /proc/i8k and set $status(lstate) and $status(rstate)
    read_i8k_status
    if {$status(lstate) < 0} {
	place forget .i8kmon.lfan
	place .i8kmon.rfan -relx 0 -rely 0.5 -relwidth 1 -relheight 0.5
    }
    if {$status(rstate) < 0} {
	place forget .i8kmon.rfan
	place .i8kmon.lfan -relx 0 -rely 0.5 -relwidth 1 -relheight 0.5
    }

    set status(bg)       [.i8kmon.lfan cget -bg]
    set status(activebg) [.i8kmon.lfan cget -activebackground]
    set status(ui)	 1

    make_menu .i8kmon

    update
}

proc make_menu {w} {
    global config
    global status

    set menu $w.menu
    menu $menu -tearoff 0
    $menu add check -label "Auto"    -variable config(auto)
    $menu add check -label "Verbose" -variable config(verbose)
    $menu add check -label "Suspend" -variable status(suspend)
    $menu add separator
    $menu add command -label "Reload" -command { read_config; status_timer }
    $menu add command -label "Exit"   -command { exit }

    bind .i8kmon.temp <Button-1> "tk_popup $menu %X %Y"
}

proc update_ui {} {
    global config
    global status

    # If applet window is unexpectedly destroyed exit the program
    if {![winfo exists .i8kmon]} {
	puts stderr "applet window destroyed, exit"
	exit 1
    }

    set bg $status(bg)
    set ab $status(activebg)

    # Temperature
    if {$status(temp) >= $config(t_high)} {
	set fg red
    } else {
	set fg black
    }
    if {$config(unit) == "F" } {
	.i8kmon.temp config -text [expr (0+$status(temp))*9/5+32] -fg $fg
    } else {
	.i8kmon.temp config -text $status(temp) -fg $fg
    }

    # Left button
    if {$status(lstate) != 0 && $status(lspeed) < $config(min_speed)} {
	incr status(lstuck)
    } else {
	set status(lstuck) 0
    }
    if {$status(lstate) == 0} {
	.i8kmon.lfan config -text {} -bg $bg -activebackground $ab
    } elseif {$status(lstuck) >= 2} {
	.i8kmon.lfan config -text $status(lstate) -bg red -activebackground red
    } else {
	.i8kmon.lfan config -text $status(lstate) -bg $bg -activebackground $ab
    }

    # Right button
    if {$status(nfans) < 2} { return }
    if {$status(rstate) != 0 && $status(rspeed) < $config(min_speed)} {
	incr status(rstuck)
    } else {
	set status(rstuck) 0
    }
    if {$status(rstate) == 0} {
	.i8kmon.rfan config -text {} -bg $bg -activebackground $ab
    } elseif {$status(rstuck) >= 2} {
	.i8kmon.rfan config -text $status(rstate) -bg red -activebackground red
    } else {
	.i8kmon.rfan config -text $status(rstate) -bg $bg -activebackground $ab
    }
}

proc toggle_fan {fan {speed {}}} {
    global status

    if {$speed != {}} {
	set status($fan) $speed
    } else {
	if {$fan == "left"} {
	    set status($fan) $status(lstate)
	} else {
	    set status($fan) $status(rstate)
	}
	set status($fan) [expr ($status($fan)+1) % 3]
    }
    if {$fan == "left"} {
	i8kfan $status($fan) {}
    } else {
	i8kfan {} $status($fan)
    }
    if {$status($fan) == 0} {
	set status($fan) {}
    }
    update_ui
}

proc usage {} {
    global argv0

    regsub -all {^.*/} $argv0 {} progname
    puts "Usage:  $progname \[<options>...]

Options:

    -a|--auto			control automatically the fans
    -na|--noauto		don\x27t control automatically the fans
    -d|--daemon			run in daemon mode without user interface
    -nd|--nodaemon		don\x27 run as daemon, open the user interface
    -v|--verbose		report status on stdout
    -g|--geometry <geometry>	set applet geometry
    -t|--timeout <seconds>	set poll timeout
    -u|--unit C|F		set temperature display unit

"
}

proc parse_options {} {
    global config
    global argv
    global PROG_VERSION

    for {set i 0} {$i < [llength $argv]} {incr i} {
	set arg [lindex $argv $i]
	switch -- $arg {
	    -\? - -h - -help - --help {
		usage
		exit
	    }
	    --daemon - -d {
		set config(daemon) 1
	    }
	    --nodaemon - -nd {
		set config(daemon) 0
	    }
	    --auto - -a {
		set config(auto) 1
	    }
	    --noauto - -na - -n {
		set config(auto) 0
	    }
	    --verbose - -v {
		set config(verbose) 1
	    }
	    --geometry - -g {
		set config(geometry) [lindex $argv [incr i]]
	    }
	    --timeout - -t {
		set config(timeout) [lindex $argv [incr i]]
	    }
	    --unit - -u {
		set config(unit) [lindex $argv [incr i]]
	    }
	    -- {
		continue
	    }
	    default {
		puts stderr "invalid option: $arg"
		exit 1
	    }
	}
    }

    if {$config(verbose) > 0} {
	set copyright "Copyright (C) 2001 Massimo Dal Zotto <dz@debian.org>"
	puts "i8kmon $PROG_VERSION - $copyright"
	parray config
    }
}

proc trap_signals {} {
    # This works only with the TclX extension library.
    catch {
	package require Tclx
	signal -restart trap SIGHUP { read_config; status_timer }
    }
}

proc main {} {
    read_config
    parse_options
    make_ui
    trap_signals
    status_timer
}

if {$tcl_interactive == 0} {
    main
    vwait forever
}

#\
MAKE_LINTIAN_HAPPY '

# Local variables:
# mode: tcl
# End:

# end of file
