Tcl/Tk Notecards

Note: you must be using at least version 2.0b4 of the Tcl Plug-in to view this demo. Make sure you configure the "outside" security policy to allow the appropriate hosts and ports. You can find information on how to configure security policies at http://sunscript.sun.com/plugin


Source code for notecrd.tcl:

# ----------------------------------------------------
# A Tcl/Tk notecards application, demonstrating the
# use of the HTTP package and the Safesock security
# policy. Written by Hattie Schroeder, 1997
#  Copyright (c) 1997 Eolas Technologies Inc.
#  Freely modifiable/redistributable under the "Standard Tcl License"
#  See http://www.eolas.com/tcl/license.txt for details
# ----------------------------------------------------




# ----------------------------------------------------
# Specify the necessary packages
# -----------------------------------------------------

policy outside
package require http


# --------------------------------------------------
# Tag an element of  main table of contents 
# to create a sub-toc
# ---------------------------------------------------

proc tag_toc { w position tagname words num } {

	$w tag add $tagname "$position wordstart" \
		 "$position wordend"

	$w tag bind $tagname  \
			"$w tag configure $tagname \
			-foreground green"
	$w tag bind $tagname  \
			"$w tag configure $tagname \
			-foreground black"
	$w tag bind $tagname  \
			 "create_sub {$words} $num"
	}

# -------------------------------------------------------
# Create a sub-toc using a specific list of words. 
# -------------------------------------------------------

proc create_sub { words  num } {

	catch [destroy .top.side.subnav]
	set Name .top.side.subnav
	text $Name     -background Lightgrey \
	    -borderwidth 2 -width 15 -height 10
	pack $Name -side top

	regsub   -all " "  $words  " \n "  title 

	$Name insert end $title
	$Name configure -state disabled

	set i 1
	foreach word  $words {	
	tagging $Name [expr $i + 1].2 link($i) \
			 $[join notes$num]($i)
	incr i
	}

}

# -------------------------------------------------
# Tag an element of a sub-toc to call the 
# ::http::geturl function.
# -------------------------------------------------

proc tagging { w position tagname note } {

	$w tag add $tagname "$position wordstart" \
			"$position wordend"
	$w tag bind $tagname  \
			"$w tag configure $tagname \
			 -foreground red"
	$w tag bind $tagname  \
			"$w tag configure $tagname \
			-foreground black"

	$w tag bind $tagname  \
		"::http::geturl \
			http://www.eolas.com/tcl/notes/$note \
			-command get_notes"
}


# ----------------------------------------------------
# Retrieve the data
# ---------------------------------------------------

proc get_notes {token} {

      upvar #0 $token state
	set data $state(body)
	.top.main.display configure -state normal
	.top.main.display delete 1.0 end
	.top.main.display insert end $data
	.top.main.display -state disabled
}

# --------------------------------------------------
# Create the text widgets and insert the main toc
# ---------------------------------------------------

set Name .top
frame $Name
pack $Name 

set Name .top.side
frame $Name 
pack $Name -side left

set Name .top.main
frame $Name 
pack $Name -side left

set Name .top.side.nav
text $Name     -background pink\
    -borderwidth 2 -height 4 -width 15

pack $Name -side top

set toc "COOKIES PIES PUDDING CAKE"

regsub  -all  " "  $toc  " \n "  title 

$Name insert end $title
$Name configure -state disabled


set Name .top.side.subnav 
text $Name -background white -width 15 -height 10
pack $Name -side left


set Name .top.main.display
text $Name -background white -borderwidth 2 \
		-height 15 -width 30 \
		-padx 5 -pady 5 -state disabled \
		-wrap word
pack $Name -side left



set Name  .top.main.scroll
scrollbar $Name -background white \
		-command {.top.main.display yview} 
pack $Name -anchor center -expand 0 -fill y \
		-ipadx 0 -ipady 0 \
       	  -padx 2 -pady 2 -side right

.top.main.display configure \
		-yscrollcommand {.top.main.scroll set}

# --------------------------------------------------
# Create arrays for each of the tocs.
# ---------------------------------------------------


array set words {
1 " ChocolateChip Sugar PeanutButter Oatmeal Brownies"
2 " Fruit Pumpkin LemonMeringue"
3 " Vanilla Chocolate Tapioca"
4 " Chocolate AngelFood Yellow"
}


array set notes1 {
1 chip.txt
2 sugar.txt 
3 peanut.txt
4 oat.txt
5 brown.txt 
}


array set notes2 {
1 fruit.txt
2 pumpkin.txt
3 lemon.txt
}

array set notes3 {
1 vanilla.txt
2 choc.txt 
3 tapi.txt
}

array set notes4 {
1 ccake.txt
2 angel.txt
3 yellow.txt
}


# ------------------------------------------------------
# Tag each element of the main table of contents.
# -----------------------------------------------------

set i 1
foreach word  $toc {
	tag_toc .top.side.nav $i.2 link($i) $words($i) $i
	incr i
	
	}