#!/usr/bin/wish -f
# -*- tcl -*-
#      The MIT License (from The Source Forge, copied 15-Oct-2001)
#
#      Copyright (c) 2001 Joe Philipps <joe@philippsfamily.org>
#
#      Permission is hereby granted, free of charge, to
#      any person obtaining a copy of this software and
#      associated documentation files (the "Software"),
#      to deal in the Software without restriction,
#      including without limitation the rights to use,
#      copy, modify, merge, publish, distribute,
#      sublicense, and/or sell copies of the Software,
#      and to permit persons to whom the Software is
#      furnished to do so, subject to the following
#      conditions:
#
#      The above copyright notice and this permission
#      notice shall be included in all copies or
#      substantial portions of the Software.
#
#      THE SOFTWARE IS PROVIDED "AS IS", WITHOUT
#      WARRANTY OF ANY KIND, EXPRESS OR IMPLIED,
#      INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
#      MERCHANTABILITY, FITNESS FOR A PARTICULAR
#      PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
#      THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR
#      ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
#      IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
#      ARISING FROM, OUT OF OR IN CONNECTION WITH THE
#      SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
#      SOFTWARE.
#
# $Revision: 1.5 $
#
# $Log: tkwebbud,v $
# Revision 1.5  2004/12/31 21:01:48  rchandra
# Windows (a.k.a. Win32) does not have a selection like a(n) X11 display does.
# ActiveState TCL (includes Tk) will manipulate the Win32 cut/copy/paste buffer
# with calls to "clipboard".  Lines were added to set up the clipboard on a
# button press.  NOTE: This environment does not "know" when the clipboard is
# superseded, so TkWebBud cannot turn the background red when something else
# goes into it from another app (or at least I don't know how to find this out).
# Again, this is due to the X11 selection model not being supported under Win32,
# or at least not under ActiveTCL.
#
# Revision 1.4  2003/04/12 18:26:04  rchandra
# Attempted to add -geometry processing when I discovered on my present system;
# RHL8.0, Tk 8.3.3, Sawfish 2.0; that wish(1) supports -geometry so I don't
# need to.  The TCL code I wrote to handle this was left in to the right
# of comment ("#") characters.  If your WM or wish(1) doesn't grok -geometry,
# you can try removing the applicable comment marks and alter the wm(n) call
# near the end.
#
# Revision 1.3  2001/10/25 14:50:02  rchandra
# If the user supplies no arguments, one is synthesized with the output
# of the hostname(1) command.
#
# Revision 1.2  2001/10/25 14:40:26  rchandra
# Added personalization information to the copyright notice
#
#
# Revision 1.1  2001/10/16 01:11:27  rchandra
# Initial revision
# 
# Revision 1.1.1.1  2001/10/25 14:36:16  rchandra
# Tk Web form Buddy makes having several strings available for the PRIMARY
# selection on an X11 server easy.  The typical application is filling in
# Web forms with one's name, address, email address, city, ZIP code, etc.
# 

set currstr 0;

proc switchstr { whatstr } {
    global currstr argv buttonobjs;

    set currstr $whatstr;
    set stringtext [lindex $argv $currstr];
    setbuttonattrs;
    set b [lindex $buttonobjs $currstr];
    $b configure -fg black -bg green3 -activebackground green3 \
	    -activeforeground black;
    take_sel;
    clipboard clear;
    clipboard append $stringtext;
}

proc take_sel {} {
    .main configure -background green4;
    selection own -selection PRIMARY -command \
	    { setbuttonattrs; .main configure -bg red4 } .;
}

proc setbuttonattrs {} {
    global buttonobjs;

    foreach b $buttonobjs {
	$b configure -bg gray40 -fg green3 \
		-activebackground gray40 -activeforeground green3;
    }
}

proc retcurrstr { offs maxlen } {
    global currstr argv;

    return [lindex $argv $currstr];
}

frame .main  -borderwidth 5 -background green4;

set i 0;
if { $argc < 1 } {
    set argv [list [exec hostname]];
}

# 2003-Apr-12 jep
# TCL at least 8.1 running under Sawfish 2.0 pays attention
# to -geometry specifications when specified.  Ergo, on the
# command line I can place my buddy on the screen without
# doing anything special like clicking the mouse anywhere.
# I coded the following before realizing wish(1) handles
# it.  It's kept here as comments as an example, or if your
# WM or wish(1) doesn't like -geometry.  Of course, the puts(n)
# commands were put in there for diagnostic before the first
# run, so that I could see it was operating right.
#
# puts "argc: $argc";
# puts "argv: $argv";
# for { set i 0 } { $i < $argc } { incr i } {
#     if { [string compare [lindex $argv $i] "--"] == 0 } {
# 	puts "found double dash end-of-opts";
# 	break;
#     } elseif { [string compare [lindex $argv $i] "-geometry"] == 0 } {
# 	puts "found geo spec at $i";
# 	set j $i;
# 	incr i;
# 	set geom $argv[$i];
# 	set argv [lreplace $argv $j $i];
# 	incr i -2;
# 	incr argc -2;
# 	puts "geo spec: $geom";
# 	puts "new argc: $argc";
# 	puts "new argv: $argv";
#     }
# }    

set buttonobjs {};
foreach txtstr $argv {
    set mybutton .main.str$i;
    lappend buttonobjs $mybutton;
    set switchfn "switchstr $i";
    button $mybutton -text $txtstr -command $switchfn;
    pack $mybutton;
    incr i;
}
button .main.xit -text "EXIT" -command { exit };
pack .main.xit;
pack .main;

selection handle -selection PRIMARY . { retcurrstr };
switchstr 0;

# wm(n) command removed when on my system (RHL8.0, Tk 8.3.3, Sawfish 2.0)
# I discovered the -geometry spec works without any intervention.
# wm geometry . +0+0;

tkwait window .;