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