1# RCS: @(#) $Id: mailwasher.tcl,v 1.17 2006/11/30 02:41:38 treectrl Exp $
2
3#
4# Demo: MailWasher
5#
6proc DemoMailWasher {} {
7
8    set T [DemoList]
9
10    InitPics *checked
11
12    set height [font metrics [$T cget -font] -linespace]
13    if {$height < 18} {
14	set height 18
15    }
16
17    #
18    # Configure the treectrl widget
19    #
20
21    $T configure -showroot no -showrootbutton no -showbuttons no \
22	-showlines no -itemheight $height -selectmode browse \
23	-xscrollincrement 20
24
25    #
26    # Create columns
27    #
28
29    set pad 4
30    $T column create -text Delete -textpadx $pad -justify center -tags delete
31    $T column create -text Bounce -textpadx $pad -justify center -tags bounce
32    $T column create -text Status -width 80 -textpadx $pad -tags status
33    $T column create -text Size -width 40 -textpadx $pad -justify right -tags size
34    $T column create -text From -width 140 -textpadx $pad -tags from
35    $T column create -text Subject -width 240 -textpadx $pad -tags subject
36    $T column create -text Received -textpadx $pad -arrow up -tags received
37    $T column create -text Attachments -textpadx $pad -tags attachments
38
39    $T state define CHECK
40
41    #
42    # Create elements
43    #
44
45    $T element create border rect -open nw -outline gray -outlinewidth 1 \
46	-fill [list $::SystemHighlight {selected}]
47    $T element create imgCheck image -image {checked CHECK unchecked {}}
48    $T element create txtAny text \
49	-fill [list $::SystemHighlightText {selected}] -lines 1
50    $T element create txtNone text -text "none" \
51	-fill [list $::SystemHighlightText {selected}] -lines 1
52    $T element create txtYes text -text "yes" \
53	-fill [list $::SystemHighlightText {selected}] -lines 1
54    $T element create txtNormal text -text "Normal" \
55	-fill [list $::SystemHighlightText {selected} #006800 {}] -lines 1
56    $T element create txtPossSpam text -text "Possible Spam"  \
57	-fill [list $::SystemHighlightText {selected} #787800 {}] -lines 1
58    $T element create txtProbSpam text -text "Probably Spam" \
59	-fill [list $::SystemHighlightText {selected} #FF9000 {}] -lines 1
60    $T element create txtBlacklist text -text "Blacklisted" \
61	-fill [list $::SystemHighlightText {selected} #FF5800 {}] -lines 1
62
63    #
64    # Create styles using the elements
65    #
66
67    set S [$T style create styCheck]
68    $T style elements $S [list border imgCheck]
69    $T style layout $S border -detach yes -iexpand xy
70    $T style layout $S imgCheck -expand news
71
72    set pad 4
73
74    foreach name {Any None Yes Normal PossSpam ProbSpam Blacklist} {
75	set S [$T style create sty$name]
76	$T style elements $S [list border txt$name]
77	$T style layout $S border -detach yes -iexpand xy
78	$T style layout $S txt$name -padx $pad -squeeze x -expand ns
79    }
80
81    #
82    # Create items and assign styles
83    #
84
85    for {set i 0} {$i < 1} {incr i} {
86	foreach {from subject} {
87	    baldy@spammer.com "Your hair is thinning"
88	    flat@spammer.com "Your breasts are too small"
89	    tiny@spammer.com "Your penis is too small"
90	    dumbass@spammer.com "You are not very smart"
91	    bankrobber@spammer.com "You need more money"
92	    loser@spammer.com "You need better friends"
93	    gossip@spammer.com "Find out what your coworkers think about you"
94	    whoami@spammer.com "Find out what you think about yourself"
95	    downsized@spammer.com "You need a better job"
96	    poorhouse@spammer.com "Your mortgage is a joke"
97	    spam4ever@spammer.com "You need more spam"
98	} {
99	    set item [$T item create]
100	    set status [lindex [list styNormal styPossSpam styProbSpam styBlacklist] [expr int(rand() * 4)]]
101	    set delete [expr int(rand() * 2)]
102	    set bounce [expr int(rand() * 2)]
103	    set attachments [lindex [list styNone styYes] [expr int(rand() * 2)]]
104	    $T item style set $item delete styCheck bounce styCheck \
105		status $status size styAny \
106		from styAny subject styAny received styAny \
107		attachments $attachments
108	    if {$delete} {
109		$T item state forcolumn $item delete CHECK
110	    }
111	    if {$bounce} {
112		$T item state forcolumn $item bounce CHECK
113	    }
114	    set bytes [expr {512 + int(rand() * 1024 * 12)}]
115	    set size [expr {$bytes / 1024 + 1}]KB
116	    set seconds [expr {[clock seconds] - int(rand() * 100000)}]
117	    set received [clock format $seconds -format "%d/%m/%y %I:%M %p"]
118	    $T item text $item size $size from $from subject $subject received $received
119	    $T item lastchild root $item
120	}
121    }
122    if 0 {
123	$T notify bind MailWasher <Button1-ElementPress-imgOn> {
124	    %T item style set %I %C styOff
125	}
126	$T notify bind MailWasher <Button1-ElementPress-imgOff> {
127	    %T item style set %I %C styOn
128	}
129    }
130
131    set ::SortColumn received
132    $T notify bind $T <Header-invoke> {
133	if {[%T column compare %C == $SortColumn]} {
134	    if {[%T column cget $SortColumn -arrow] eq "down"} {
135		set order -increasing
136		set arrow up
137	    } else {
138		set order -decreasing
139		set arrow down
140	    }
141	} else {
142	    if {[%T column cget $SortColumn -arrow] eq "down"} {
143		set order -decreasing
144		set arrow down
145	    } else {
146		set order -increasing
147		set arrow up
148	    }
149	    %T column configure $SortColumn -arrow none
150	    set SortColumn %C
151	}
152	%T column configure %C -arrow $arrow
153	switch [%T column cget %C -tags] {
154	    bounce -
155	    delete {
156		%T item sort root $order -column %C -command [list CompareOnOff %T %C] -column subject -dictionary
157	    }
158	    status {
159		%T item sort root $order -column %C -dictionary
160	    }
161	    from {
162		%T item sort root $order -column %C -dictionary -column subject -dictionary
163	    }
164	    subject {
165		%T item sort root $order -column %C -dictionary
166	    }
167	    size {
168		%T item sort root $order -column %C -dictionary -column subject -dictionary
169	    }
170	    received {
171		%T item sort root $order -column %C -dictionary -column subject -dictionary
172	    }
173	    attachments {
174		%T item sort root $order -column %C -dictionary -column subject -dictionary
175	    }
176	}
177    }
178
179    bind DemoMailWasher <ButtonPress-1> {
180	set id [%W identify %x %y]
181	if {$id eq ""} {
182	} elseif {[lindex $id 0] eq "header"} {
183	} else {
184	    lassign $id what item where arg1 arg2 arg3
185	    if {$where eq "column"} {
186		if {[%W column tag expr $arg1 {delete || bounce}]} {
187		    %W item state forcolumn $item $arg1 ~CHECK
188#					return -code break
189		}
190	    }
191	}
192    }
193
194    bindtags $T [list $T DemoMailWasher TreeCtrl [winfo toplevel $T] all]
195
196    return
197}
198
199proc CompareOnOff {T C item1 item2} {
200    set s1 [$T item state forcolumn $item1 $C]
201    set s2 [$T item state forcolumn $item2 $C]
202    if {$s1 eq $s2} { return 0 }
203    if {[lsearch -exact $s1 CHECK] == -1} { return -1 }
204    return 1
205}
206
207