summaryrefslogtreecommitdiffstats
path: root/demos/outlook-newgroup.tcl
blob: 54c0b3943d7928053b8a7a956dc1e249b27cb409 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
#
# 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 create -image outlook-clip -tag clip
	$T column create -image outlook-arrow -tag arrow
	$T column create -image outlook-watch -tag watch
	$T column create -text Subject -width 250 -tag subject
	$T column create -text From -width 150 -tag from
	$T column create -text Sent -width 150 -tag sent
	$T column create -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 -padx {2 6} -squeeze x -expand ns
	$T style layout $S sel.e -union [list elemTxt] -iexpand nes -ipadx {2 0}

	# Text
	set S [$T style create s2.we]
	$T style elements $S {sel.we elemTxt}
	$T style layout $S elemTxt -padx 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 -padx 6 -squeeze x -expand ns
	$T style layout $S sel.w -detach yes -iexpand es

	# Set default item style
	$T configure -defaultstyle [list "" "" "" s1 s2.we s2.we s2.w]

	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 set $i read
		}

		# This message has unread descendants
		if {[AnyUnreadDescendants $T $i]} {
			$T item state set $i unread
		}

		if {[$T item numchildren $i]} {
			$T item configure $i -button 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 set $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 set $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 create -image outlook-clip -tag clip
	$T column create -image outlook-arrow -tag arrow
	$T column create -image outlook-watch -tag watch
	$T column create -text Subject -width 250 -tag subject
	$T column create -text From -width 150 -tag from
	$T column create -text Sent -width 150 -tag sent
	$T column create -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 -padx {2 6} -squeeze x -expand ns
	$T style layout $S sel.e -union [list text.unread] -iexpand nes -ipadx {2 0}

	# 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 -padx {2 6} -squeeze x -expand ns
	$T style layout $S sel.e -union [list text.read] -iexpand nes -ipadx {2 0}

	# 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 -padx {2 6} -squeeze x -expand ns
	$T style layout $S sel.e -union [list text.unread] -iexpand nes -ipadx {2 0}

	# Text
	set S [$T style create unread.we]
	$T style elements $S {sel.we text.unread}
	$T style layout $S text.unread -padx 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 -padx 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 -padx 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 -padx 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 configure $i -button 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
}