Initial revision

1 files changed, 382 insertions, 0 deletions

diff --git a/demos/outlook-newgroup.tcl b/demos/outlook-newgroup.tcl
new file mode 100644
index 0000000..1a18e91
--- /dev/null
+++ b/demos/outlook-newgroup.tcl
@@ -0,0 +1,382 @@
+#
+# Demo: Outlook Express newsgroup messages
+#
+proc DemoOutlookNewsgroup {} {
+
+	global Message
+
+	InitPics outlook-*
+
+	set T .f2.f1.t
+
+	set height [font metrics [$T cget -font] -linespace]
+	if {$height < 18} {
+		set height 18
+	}
+	$T configure -itemheight $height -selectmode browse \
+		-showroot no -showrootbutton no -showbuttons yes -showlines no
+
+	$T column configure 0 -image outlook-clip -tag clip
+	$T column configure 1 -image outlook-arrow -tag arrow
+	$T column configure 2 -image outlook-watch -tag watch
+	$T column configure 3 -text Subject -width 250 -tag subject
+	$T column configure 4 -text From -width 150 -tag from
+	$T column configure 5 -text Sent -width 150 -tag sent
+	$T column configure 6 -text Size -width 60 -justify right -tag size
+
+	# Would be nice if I could specify a column -tag too
+	$T configure -treecolumn 3
+
+	# State for a read message
+	$T state define read
+
+	# State for a message with unread descendants
+	$T state define unread
+
+	$T element create elemImg image -image {
+		outlook-read-2Sel {selected read unread !open}
+		outlook-read-2 {read unread !open}
+		outlook-readSel {selected read}
+		outlook-read {read}
+		outlook-unreadSel {selected}
+		outlook-unread {}
+	}
+	$T element create elemTxt text -fill [list $::SystemHighlightText {selected focus}] \
+		-font [list "[$T cget -font] bold" {read unread !open} "[$T cget -font] bold" {!read}] -lines 1
+	$T element create sel.e rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] -open e -showfocus yes
+	$T element create sel.w rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] -open w -showfocus yes
+	$T element create sel.we rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] -open we -showfocus yes
+
+	# Image + text
+	set S [$T style create s1]
+	$T style elements $S {sel.e elemImg elemTxt}
+	$T style layout $S elemImg -expand ns
+	$T style layout $S elemTxt -padw 2 -pade 6 -squeeze x -expand ns
+	$T style layout $S sel.e -union [list elemTxt] -iexpand nes -ipadw 2
+
+	# Text
+	set S [$T style create s2.we]
+	$T style elements $S {sel.we elemTxt}
+	$T style layout $S elemTxt -padw 6 -pade 6 -squeeze x -expand ns
+	$T style layout $S sel.we -detach yes -iexpand es
+
+	# Text
+	set S [$T style create s2.w]
+	$T style elements $S {sel.w elemTxt}
+	$T style layout $S elemTxt -padw 6 -pade 6 -squeeze x -expand ns
+	$T style layout $S sel.w -detach yes -iexpand es
+
+	set msgCnt 100
+
+	set thread 0
+	set Message(count,0) 0
+	for {set i 1} {$i < $msgCnt} {incr i} {
+		$T item create
+		while 1 {
+			set j [expr {int(rand() * $i)}]
+			if {$j == 0} break
+			if {[$T depth $j] == 5} continue
+			if {$Message(count,$Message(thread,$j)) == 15} continue
+			break
+		}
+		$T item lastchild $j $i
+
+		set Message(read,$i) [expr rand() * 2 > 1]
+		if {$j == 0} {
+			set Message(thread,$i) [incr thread]
+			set Message(seconds,$i) [expr {[clock seconds] - int(rand() * 500000)}]
+			set Message(seconds2,$i) $Message(seconds,$i)
+			set Message(count,$thread) 1
+		} else {
+			set Message(thread,$i) $Message(thread,$j)
+			set Message(seconds,$i) [expr {$Message(seconds2,$j) + int(rand() * 10000)}]
+			set Message(seconds2,$i) $Message(seconds,$i)
+			set Message(seconds2,$j) $Message(seconds,$i)
+			incr Message(count,$Message(thread,$j))
+		}
+	}
+
+	for {set i 1} {$i < $msgCnt} {incr i} {
+		set subject "This is thread number $Message(thread,$i)"
+		set from somebody@somewhere.net
+		set sent [clock format $Message(seconds,$i) -format "%d/%m/%y %I:%M %p"]
+		set size [expr {1 + int(rand() * 10)}]KB
+
+		# This message has been read
+		if {$Message(read,$i)} {
+			$T item state $i read
+		}
+
+		# This message has unread descendants
+		if {[AnyUnreadDescendants $T $i]} {
+			$T item state $i unread
+		}
+
+		if {[$T item numchildren $i]} {
+			$T item hasbutton $i yes
+
+			# Collapse some messages
+			if {rand() * 2 > 1} {
+				$T collapse $i
+			}
+		}
+
+		$T item style set $i 3 s1 4 s2.we 5 s2.we 6 s2.w
+		$T item text $i 3 $subject 4 $from 5 $sent 6 $size
+	}
+
+	# Do something when the selection changes
+	$T notify bind $T <Selection> {
+
+		# One item is selected
+		if {[%T selection count] == 1} {
+			if {[info exists Message(afterId)]} {
+				after cancel $Message(afterId)
+			}
+			set Message(afterId,item) [lindex [%T selection get] 0]
+			set Message(afterId) [after 500 MessageReadDelayed]
+		}
+	}
+
+	return
+}
+
+proc MessageReadDelayed {} {
+
+	global Message
+
+	set T .f2.f1.t
+
+	unset Message(afterId)
+	set I $Message(afterId,item)
+	if {![$T selection includes $I]} return
+
+	# This message is not read
+	if {!$Message(read,$I)} {
+
+		# Read the message
+		$T item state $I read
+		set Message(read,$I) 1
+
+		# Check ancestors (except root)
+		foreach I2 [lrange [$T item ancestors $I] 0 end-1] {
+
+			# This ancestor has no more unread descendants
+			if {![AnyUnreadDescendants $T $I2]} {
+				$T item state $I2 !unread
+			}
+		}
+	}
+}
+
+# Alternate implementation which does not rely on run-time states
+proc DemoOutlookNewsgroup2 {} {
+
+	global Message
+
+	InitPics outlook-*
+
+	set T .f2.f1.t
+
+	set height [font metrics [$T cget -font] -linespace]
+	if {$height < 18} {
+		set height 18
+	}
+	$T configure -itemheight $height -selectmode browse \
+		-showroot no -showrootbutton no -showbuttons yes -showlines no
+
+	$T column configure 0 -image outlook-clip -tag clip
+	$T column configure 1 -image outlook-arrow -tag arrow
+	$T column configure 2 -image outlook-watch -tag watch
+	$T column configure 3 -text Subject -width 250 -tag subject
+	$T column configure 4 -text From -width 150 -tag from
+	$T column configure 5 -text Sent -width 150 -tag sent
+	$T column configure 6 -text Size -width 60 -justify right -tag size
+
+	$T configure -treecolumn 3
+
+	$T element create image.unread image -image outlook-unread
+	$T element create image.read image -image outlook-read
+	$T element create image.read2 image -image outlook-read-2
+	$T element create text.read text -fill [list $::SystemHighlightText {selected focus}] \
+		-lines 1
+	$T element create text.unread text -fill [list $::SystemHighlightText {selected focus}] \
+		-font [list "[$T cget -font] bold"] -lines 1
+	$T element create sel.e rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] -open e -showfocus yes
+	$T element create sel.w rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] -open w -showfocus yes
+	$T element create sel.we rect -fill [list $::SystemHighlight {selected focus} gray {selected !focus}] -open we -showfocus yes
+
+	# Image + text
+	set S [$T style create unread]
+	$T style elements $S {sel.e image.unread text.unread}
+	$T style layout $S image.unread -expand ns
+	$T style layout $S text.unread -padw 2 -pade 6 -squeeze x -expand ns
+	$T style layout $S sel.e -union [list text.unread] -iexpand nes -ipadw 2
+
+	# Image + text
+	set S [$T style create read]
+	$T style elements $S {sel.e image.read text.read}
+	$T style layout $S image.read -expand ns
+	$T style layout $S text.read -padw 2 -pade 6 -squeeze x -expand ns
+	$T style layout $S sel.e -union [list text.read] -iexpand nes -ipadw 2
+
+	# Image + text
+	set S [$T style create read2]
+	$T style elements $S {sel.e image.read2 text.unread}
+	$T style layout $S image.read2 -expand ns
+	$T style layout $S text.unread -padw 2 -pade 6 -squeeze x -expand ns
+	$T style layout $S sel.e -union [list text.unread] -iexpand nes -ipadw 2
+
+	# Text
+	set S [$T style create unread.we]
+	$T style elements $S {sel.we text.unread}
+	$T style layout $S text.unread -padw 6 -pade 6 -squeeze x -expand ns
+	$T style layout $S sel.we -detach yes -iexpand es
+
+	# Text
+	set S [$T style create read.we]
+	$T style elements $S {sel.we text.read}
+	$T style layout $S text.read -padw 6 -pade 6 -squeeze x -expand ns
+	$T style layout $S sel.we -detach yes -iexpand es
+
+	# Text
+	set S [$T style create unread.w]
+	$T style elements $S {sel.w text.unread}
+	$T style layout $S text.unread -padw 6 -pade 6 -squeeze x -expand ns
+	$T style layout $S sel.w -detach yes -iexpand es
+
+	# Text
+	set S [$T style create read.w]
+	$T style elements $S {sel.w text.read}
+	$T style layout $S text.read -padw 6 -pade 6 -squeeze x -expand ns
+	$T style layout $S sel.w -detach yes -iexpand es
+
+	set msgCnt 100
+
+	set thread 0
+	set Message(count,0) 0
+	for {set i 1} {$i < $msgCnt} {incr i} {
+		$T item create
+		while 1 {
+			set j [expr {int(rand() * $i)}]
+			if {$j == 0} break
+			if {[$T depth $j] == 5} continue
+			if {$Message(count,$Message(thread,$j)) == 15} continue
+			break
+		}
+		$T item lastchild $j $i
+
+		set Message(read,$i) [expr rand() * 2 > 1]
+		if {$j == 0} {
+			set Message(thread,$i) [incr thread]
+			set Message(seconds,$i) [expr {[clock seconds] - int(rand() * 500000)}]
+			set Message(seconds2,$i) $Message(seconds,$i)
+			set Message(count,$thread) 1
+		} else {
+			set Message(thread,$i) $Message(thread,$j)
+			set Message(seconds,$i) [expr {$Message(seconds2,$j) + int(rand() * 10000)}]
+			set Message(seconds2,$i) $Message(seconds,$i)
+			set Message(seconds2,$j) $Message(seconds,$i)
+			incr Message(count,$Message(thread,$j))
+		}
+	}
+
+	for {set i 1} {$i < $msgCnt} {incr i} {
+		set subject "This is thread number $Message(thread,$i)"
+		set from somebody@somewhere.net
+		set sent [clock format $Message(seconds,$i) -format "%d/%m/%y %I:%M %p"]
+		set size [expr {1 + int(rand() * 10)}]KB
+		if {$Message(read,$i)} {
+			set style read
+			set style2 read
+		} else {
+			set style unread
+			set style2 unread
+		}
+		$T item style set $i 3 $style 4 $style2.we 5 $style2.we 6 $style2.w
+		$T item text $i 3 $subject 4 $from 5 $sent 6 $size
+		if {[$T item numchildren $i]} {
+			$T item hasbutton $i yes
+		}
+	}
+
+	$T notify bind $T <Selection> {
+		if {[%T selection count] == 1} {
+			set I [lindex [%T selection get] 0]
+			if {!$Message(read,$I)} {
+				if {[%T item isopen $I] || ![AnyUnreadDescendants %T $I]} {
+					# unread ->read
+					%T item style map $I subject read {text.unread text.read}
+					%T item style map $I from read.we {text.unread text.read}
+					%T item style map $I sent read.we {text.unread text.read}
+					%T item style map $I size read.w {text.unread text.read}
+				} else {
+					# unread -> read2
+					%T item style map $I subject read2 {text.unread text.unread}
+				}
+				set Message(read,$I) 1
+				DisplayStylesInItem $I
+			}
+		}
+	}
+
+	$T notify bind $T <Expand-after> {
+		if {$Message(read,%I) && [AnyUnreadDescendants %T %I]} {
+			# read2 -> read
+			%T item style map %I subject read {text.unread text.read}
+			# unread -> read
+			%T item style map %I from read.we {text.unread text.read}
+			%T item style map %I sent read.we {text.unread text.read}
+			%T item style map %I size read.w {text.unread text.read}
+		}
+	}
+
+	$T notify bind $T <Collapse-after> {
+		if {$Message(read,%I) && [AnyUnreadDescendants %T %I]} {
+			# read -> read2
+			%T item style map %I subject read2 {text.read text.unread}
+			# read -> unread
+			%T item style map %I from unread.we {text.read text.unread}
+			%T item style map %I sent unread.we {text.read text.unread}
+			%T item style map %I size unread.w {text.read text.unread}
+		}
+	}
+
+	for {set i 1} {$i < $msgCnt} {incr i} {
+		if {rand() * 2 > 1} {
+			if {[$T item numchildren $i]} {
+				$T collapse $i
+			}
+		}
+	}
+
+	return
+}
+proc AnyUnreadDescendants {T I} {
+
+	global Message
+
+	set itemList [$T item firstchild $I]
+	while {[llength $itemList]} {
+		# Pop
+		set item [lindex $itemList end]
+		set itemList [lrange $itemList 0 end-1]
+
+		if {!$Message(read,$item)} {
+			return 1
+		}
+
+		set item2 [$T item nextsibling $item]
+		if {$item2 ne ""} {
+			# Push
+			lappend itemList $item2
+		}
+		set item2 [$T item firstchild $item]
+		if {$item2 ne ""} {
+			# Push
+			lappend itemList $item2
+		}
+	}
+
+	return 0
+}