Important!: because of move from the sunscript.sun.com to this new home http://www.demailly.com/tcl/plugin/, not everything is updated or fully working yet... stay tuned...

Feedback form Tclet demo

This page demonstrates the kind of stuff you can easily do, and also was used to let us know what you think of the Tcl plugin. You could enter your email address and name (not required, but we liked to know who you were) and comments, and then use the various sliders to describe yourself. When done, hitting the `Submit' button would make the Tclet send your comments to Sunscript via e-mail. That e-mail address might already be decommissioned, so don't put too much efforts filling that form, rather send you comments directly to the authors or on the newsgroup comp.lang.tcl.

Source:

# Guestbook.tcl --
#
#	A UI to let users of the Tcl plugin submit comments to us using
#	a Tclet (of course!).
#
# CONTACT:      sunscript-plugin@sunscript.sun.com
#
# AUTHORS:      Jacob Levy              Laurent Demailly
#               jyl@eng.sun.com         demailly@eng.sun.com
#               jyl@tcl-tk.com          L@Demailly.com
#
# Please contact us directly for questions, comments and enhancements.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# This is called when an error occurs or when the user has submitted her
# comments:

proc endUI {msg} {
    foreach w [winfo children .] {
	destroy $w
    }
    foreach a [after info] {
	after cancel $a
    }
    message .m -text $msg -width 350 -bd 2 -relief ridge -padx 5 -pady 5
    place .m -relx .5 -rely .5 -anchor c
}
proc bgerror {msg} {
    endUI "error: $msg"
}

if {[catch {policy javascript} msg]} {
    endUI "Sorry, can't run: could not acquire the javascript policy: $msg"
    return
}

# Where to send the form to:

set url mailto:sunscript-plugin@sunscript.sun.com

# Have we sent the comments yet?

set sent 0

# Global state used to store the content of the form:

set plugin(pkgVersion) [package require plugin]
set userAgent [getattr userAgent]

if {"$userAgent"=="Microsoft Internet Explorer"} {
    endUI "Sorry, can't run: sending feedback by email from IE does not work"
    return
}

set valuesToSend {tcl_platform(platform) plugin(patchLevel)
   plugin(release) plugin(pkgVersion) tcl_patchLevel tk_patchLevel
   userAgent
}

# Functionality:

proc clearit {} {
    .text.msg delete 1.0 end
}

proc endCB {args} {
    log "Called endCB $args"
}

proc sendit {} {
    global url
    global sent
    global valuesToSend

    set values [list "Subject: Tcl Plugin Auto Feedback\n"]
    foreach i $valuesToSend {
	upvar #0 $i v

	lappend values "$i: $v"
    }
    lappend values "comments: [.text.msg get 1.0 end]"

    ::browser::getForm $url [join $values \n] 1 0 {} {} endCB
    endUI "Thank you for submitting your comments!"
}

proc setscale {widget var args} {
    global $var

    set val [expr [set $var] * 255 / 100]
    set r $val
    set g [expr $val * 2 % 256]
    set b [expr $val * 4 % 256]
    $widget configure -troughcolor #[format %.2X%.2X%.2X $r $g $b]
}

# UI:

proc fieldcompound {w fl lv {fe ""} {dv ""}} {
    global valuesToSend

    label $w.$fl -text $lv
    if {[string compare $fe ""] == 0} {
	grid $w.$fl x
    } else {
	global $fe
	entry $w.$fe -textvariable $fe -width 35
	set $fe $dv
	lappend valuesToSend $fe
	grid $w.$fl $w.$fe -sticky ew
    }
}

frame .details
message .details.top -aspect 2000 -text "Please send your comments:" \
	-relief ridge -bd 2 -padx 2 -pady 2
grid .details.top -column 1
grid rowconfigure .details 0 -pad 5
fieldcompound .details namel "Name: " name "Please enter your name here"
fieldcompound .details emaill "Email: " email \
	"Please enter your email address here"
fieldcompound .details blank1 ""
fieldcompound .details comments "Enter comments: "
pack .details -fill x
 
proc MkTxtWin {w} {
    frame $w
    text $w.msg -yscrollcommand "$w.scroll set" -wrap word
    scrollbar $w.scroll -command "$w.msg yview" -width 12
    pack $w.scroll -side right -fill y
    pack $w.msg -side left -fill both -expand yes
    return $w.msg
}
MkTxtWin .text

proc scalecompound {w l lt s v lv} {
    global $v
    global gridline
    global valuesToSend

    set $v 0
    label $w.$l -text $lt
    scale $w.$s -variable $v -orient horizontal \
	  -command "setscale $w.$s $v" -showvalue 0
    label $w.$lv -textvariable $v
    grid $w.$l -row $gridline -column 0 -sticky e
    grid $w.$s -row $gridline -column 1 -sticky ew
    grid $w.$lv -row $gridline -column 2 -sticky w
    incr gridline
    setscale $w.$s $v
    lappend valuesToSend $v
}

frame .d
fieldcompound .d describe "Please describe yourself: "

frame .scales -bd 0
set gridline 0
scalecompound .scales expert "Tcl expertise: " expertscale expertise \
	expertlv
scalecompound .scales docgi "CGI expertise: " docgiscale docgi docgilv
scalecompound .scales lovetcl "Love Tcl? " lovetscale lovetcl lovetlv
scalecompound .scales lovejs "Love Javascript? " lovejsscale lovejs \
	lovejslv
scalecompound .scales lovej "Love Java? " lovejscale lovej lovejlv
grid columnconfigure .scales 0 -pad 5
grid columnconfigure .scales 1 -weight 1
grid columnconfigure .scales 2 -minsize 30

frame .ticker -bd 2 -relief groove -borderwidth 5
text .ticker.t -state disabled -height 1
pack .ticker.t -fill x
.ticker.t tag configure tagred -foreground red
proc getmessage {} {
    global name
    global sent

    if {$sent} {
	set prefix "Thank you, "
    } else {
	set prefix "Hello, "
    }
    if {[string compare $name "Please enter your name here"] == 0} {
	return [list "*** $prefix stranger ***"]
    }
    set firstname [lindex [split $name " "] 0]
    return [list "*** $prefix ${firstname}! ***" tagred]
}
proc ticker {w e} {
    scan [$w index 1.end] %d.%d line len
    if {$len < $e} {
	$w configure -state normal
	eval $w insert end [getmessage]
	$w configure -state disabled
    }
    $w configure -state normal
    $w delete 0.1
    $w configure -state disabled
    after 200 [list ticker $w $e]
}
ticker .ticker.t 30
pack .ticker -side bottom -fill x

frame .bottom
button .bottom.clear -text "Clear comments" -command clearit
button .bottom.send -text "Submit comments" -command sendit
pack .bottom.clear -side left -padx 5 -pady 5
pack .bottom.send -side right -padx 5 -pady 5

pack .bottom -side bottom -fill x
pack .scales -side bottom -fill x
pack .d -fill x -side bottom
pack .text -side bottom -expand y -fill both

focus .text.msg

Last modified: Mon Apr 13 1998, 11:05, hosted by