Tcl Source Code

Artifact 45f21f81c427e0000ed9a6018278218f3add51e4:

Attachment "lock.tcl" to ticket [417839ffff] added by agentorange 2001-04-21 21:54:59.

---

#!/usr/bin/env wish

set lock 0
set temp 0

proc getLock {} {
	global lock

	while {$lock} {
		vwait lock
	}
	set lock 1 
}

proc freeLock {} {
	global lock

	set lock 0
}

proc f1 {} {
	puts "in f1: before getLock"
	getLock
	puts "in f1: after getLock"

	freeLock
}

proc f2 {} {
	global temp

	puts "in f2: before getLock"
	getLock
	puts "in f2: after getLock"

	after 1000 {puts "temp: $temp"; set temp 1; puts "temp: $temp"}

	puts "in f2: before vwait temp"
	vwait temp
	puts "in f2: after vwait temp"

	freeLock
}

button .b -text "foo" -command {puts "foo"}
pack .b
after 1 f1
f2