Subject: FVWM: CLock in FvwmButtons

From: Adam Kopacz <[email-masked]>
Date: Mon, 09 Jun 1997 22:55:04 +0200

Hi,

i have attached a tcl/tk clock/Date script.
it looks great in FvwmButtons! :-)) =>

*FvwmButtons(1x1) - whatever Swallow "time" Exec /root/scripts/time -geometry +100+600 &

start with './time' or 'wish time' or 'wish8.0 time' .. 

-- 
Bye,    
    Adam Kopacz      http://www.rat.de/Adam
#! /bin/sh
# tcl/tk time/date script by Adam Kopacz [[email-masked]]
# *-tcl-* \
exec wish "$0" "$@"

proc update_digital_time {} {
    global digitalClockFormat digitalClockFrame

    $digitalClockFrame configure -text [clock format [clock seconds] -format $digitalClockFormat]
    .lab2 configure -text [clock format [clock seconds] -format "%d.%m.1997"]

}

proc update_digital_time_and_repeat {} {
    update_digital_time
    after [expr {60 - ([clock seconds] % 60)}]000 update_digital_time_and_repeat
}

proc set_digital_format {format} {
    global digitalClockFormat currentFormatNumber nFormats

    set nFormats 2

    case $format {
        0 {set digitalClockFormat "%I:%M %p"}
        1 {set digitalClockFormat "%H:%M"}
    }

    set currentFormatNumber $format
}

proc next_format {} {
    global currentFormatNumber nFormats

    incr currentFormatNumber
    if {$currentFormatNumber >= $nFormats} {
	set currentFormatNumber 0
    }
    set_digital_format  $currentFormatNumber
    update_digital_time
}

proc digital_clock {nframe} {
    global digitalClockFrame

    set digitalClockFrame $nframe
    button $nframe -font "-adobe-helvetica-normal-r-*-*-11-*-*-*-*-*-*-" -command next_format -background #908090 -foreground #000040 -pady 2m -activebackground #909090
    label .lab2  -text "xx.xx.xx" -bg #908090 -font "-adobe-helvetica-normal-r-*-*-10-*-*-*-*-*-*-*" 

    update_digital_time_and_repeat
    return
}

set_digital_format 1

proc doit {} {

    . configure -background #908090
    digital_clock .dclock
    pack .dclock -pady 1m -padx 1m -fill both -expand yes   
    pack .lab2 -anchor c -fill both -expand yes
}

if !$tcl_interactive {
    global errorInfo

    if {[catch doit result] == 1} {
	puts stderr $errorInfo
    }
}