FVWM: CLock in FvwmButtons

From: Adam Kopacz <Adam.Kopacz_at_rhein-neckar.netsurf.de>
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 [klo_at_writeme.com]
# *-tcl-* \
exec wish "$0" "$_at_"

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
    }
}

--
Visit the official FVWM web page at <URL:http://www.hpc.uh.edu/fvwm/>.
To unsubscribe from the list, send "unsubscribe fvwm" in the body of a
message to majordomo_at_hpc.uh.edu.
To report problems, send mail to fvwm-owner_at_hpc.uh.edu.

Received on Mon Jun 09 1997 - 21:28:41 BST