1# $Id$ 2 3option add *Messages.listheight 10 widgetDefault 4 5namespace eval ::message_archive { 6 variable logdir [file join $::configdir logs] 7 8 if {![file exists $logdir]} { 9 file mkdir $logdir 10 } 11 12 variable archive_file [file join $logdir message_archive] 13 variable label 14 array set label [list to [::msgcat::mc "To:"] from [::msgcat::mc "From:"]] 15 16 variable messages 17} 18 19############################################################################# 20 21proc ::message_archive::str_to_log {str} { 22 return [string map {\\ \\\\ \r \\r \n \\n} $str] 23} 24 25############################################################################# 26 27proc ::message_archive::log_to_str {str} { 28 return [string map {\\\\ \\ \\r \r \\n \n} $str] 29} 30 31############################################################################# 32 33proc ::message_archive::log_message {from to subject body x} { 34 variable archive_file 35 36 set seconds [::xmpp::xml::getAttr [::xmpp::delay::parse $x] seconds] 37 set ts [clock format $seconds -format "%Y%m%dT%H%M%S"] 38 39 set fd [open $archive_file a] 40 fconfigure $fd -encoding utf-8 41 puts $fd [str_to_log [list timestamp $ts id $ts[rand 10000] from $from to $to subject $subject body $body]] 42 close $fd 43} 44 45proc ::message_archive::show_archive {} { 46 variable lastsort 47 variable label 48 variable messages 49 50 set w .message_archive 51 if {[winfo exists $w]} { 52 return 53 } 54 55 add_win $w -title [::msgcat::mc "Messages"] \ 56 -tabtitle [::msgcat::mc "Messages"] \ 57 -class Messages \ 58 -raise 1 59 60 PanedWin $w.pw -side right -pad 0 -width 4 61 pack $w.pw -fill both -expand yes 62 63 set uw [PanedWinAdd $w.pw -weight 0 -minsize 100] 64 set dw [PanedWinAdd $w.pw -weight 1 -minsize 100] 65 66 frame $dw.title 67 label $dw.title.label -text $label(from) 68 label $dw.title.jid 69 pack $dw.title -fill x 70 pack $dw.title.label -side left 71 pack $dw.title.jid -side left 72 73 frame $dw.subject 74 label $dw.subject.lsubj -text [::msgcat::mc "Subject:"] 75 label $dw.subject.subj 76 pack $dw.subject -fill x 77 pack $dw.subject.lsubj -side left 78 pack $dw.subject.subj -side left 79 80 set body [ScrolledWindow $dw.sw] 81 text $body.body -height 20 -state disabled -wrap word 82 pack $body -expand yes -fill both -anchor nw 83 $body setwidget $body.body 84 ::richtext::config $body.body -using {url emoticon stylecode} 85 86 set sww [ScrolledWindow $w.items] 87 88 set height [option get $w listheight Messages] 89 ::mclistbox::mclistbox $sww.listbox \ 90 -resizeonecolumn 1 \ 91 -labelanchor w \ 92 -width 90 \ 93 -height $height 94 set l $sww.listbox 95 96 pack $sww -expand yes -fill both -anchor nw -in $uw 97 $sww setwidget $l 98 99 [winfo parent $uw] configure \ 100 -height [expr {int( 1.2*($height+1)*[font metrics [$l cget -font] -linespace] )}] 101 102 103 set lastsort($l) "" 104 bind $l <Destroy> +[list [namespace current]::delete_lastsort %W] 105 106 bind $l <1> \ 107 "[namespace current]::select_and_print_body \ 108 [double% $dw] [double% $l] \[[double% $l] nearest \[::mclistbox::convert %W -y %y\]\]" 109 110# bind $l <<ContextMenu>> \ 111# "[namespace current]::select_and_popup_menu \ 112# [double% $l] \[[double% $l] nearest \[::mclistbox::convert %W -y %y\]\]" 113 114 bindscroll $sww $l 115 116 $l column add N -label " [::msgcat::mc #] " 117 $l column add id -label "" -visible 0 118 $l column add timestamp -label " [::msgcat::mc Received/Sent] " 119 $l column add dir -label " [::msgcat::mc Dir] " 120 $l column add fromto -label " [::msgcat::mc From/To] " 121 $l column add subject -label " [::msgcat::mc Subject] " 122 123 array unset messages 124 125 foreach var {timestamp fromto subject} { 126 $l label bind $var <ButtonPress-1> "[namespace current]::sort %W [double% $var]" 127 } 128 129 $l column add lastcol -label "" -width 0 130 $l configure -fillcolumn lastcol 131 132 fill_list $l 133 134 $l see end 135 select_and_print_body $dw $l end 136} 137 138proc ::message_archive::max {a b} { 139 return [expr {$a > $b ? $a : $b}] 140} 141 142proc ::message_archive::fill_list {l} { 143 variable archive_file 144 145 if {![file exists $archive_file]} { 146 return 147 } 148 149 foreach i {N timestamp dir fromto subject} { 150 $l column configure $i -width [string length [$l column cget $i -label]] 151 } 152 153 set hist {} 154 set fd [open $archive_file r] 155 fconfigure $fd -encoding utf-8 156 while {[gets $fd line] > 0} { 157 catch {fill_row $l [log_to_str $line]} 158 } 159 close $fd 160} 161 162proc ::message_archive::fill_row {l var} { 163 variable messages 164 165 set connections [connections] 166 if {[lempty $connections]} { 167 set myjid "" 168 } else { 169 set myjid [connection_bare_jid [lindex $connections 0]] 170 } 171 172 foreach i {N id timestamp dir fromto subject} { 173 set width($i) [$l column cget $i -width] 174 } 175 176 set rownum [$l size] 177 incr rownum 178 set row [list " $rownum "] 179 set width(N) [max [string length " $rownum "] $width(N)] 180 array unset tmp 181 array set tmp $var 182 if {[info exists tmp(id)]} { 183 set id $tmp(id) 184 lappend row $id 185 set width(id) 0 186 } else { 187 return 188 } 189 if {[info exists tmp(timestamp)]} { 190 set seconds [clock scan $tmp(timestamp) -gmt 0] 191 set str " [clock format $seconds -format {%Y-%m-%d %X}] " 192 lappend row $str 193 set width(timestamp) [max [string length $str] $width(timestamp)] 194 } else { 195 lappend row {} 196 } 197 set q 0 198 if {[info exists tmp(from)]} { 199 set str [::xmpp::jid::stripResource $tmp(from)] 200 if {$str == $myjid} { 201 set q 1 202 set fromto to 203 set dir " -> " 204 set messages($id,dir) to 205 } 206 } else { 207 set tmp(from) {} 208 } 209 if {[info exists tmp(to)]} { 210 set str [::xmpp::jid::stripResource $tmp(to)] 211 if {$str == $myjid} { 212 set q 1 213 set fromto from 214 set dir " <- " 215 set messages($id,dir) from 216 } 217 } else { 218 set tmp(to) {} 219 } 220 if {!$q} { 221 return 222 } else { 223 lappend row $dir 224 set str [::xmpp::jid::stripResource $tmp($fromto)] 225 lappend row " $str " 226 set width(fromto) [max [string length " $str "] $width(fromto)] 227 set messages($id,fromto) $tmp($fromto) 228 } 229 if {[info exists tmp(subject)]} { 230 lappend row " $tmp(subject) " 231 set width(subject) [max [string length " $tmp(subject) "] $width(subject)] 232 set messages($id,subject) $tmp(subject) 233 } else { 234 lappend row {} 235 set messages($id,subject) "" 236 } 237 if {[info exists tmp(body)]} { 238 set messages($id,body) $tmp(body) 239 } else { 240 set messages($id,body) "" 241 } 242 $l insert end $row 243 244 foreach i {N timestamp id dir fromto subject} { 245 $l column configure $i -width $width($i) 246 } 247} 248 249proc ::message_archive::sort {l tag} { 250 variable lastsort 251 252 set data [$l get 0 end] 253 set index [lsearch -exact [$l column names] $tag] 254 if {$lastsort($l) != $tag} { 255 set result [lsort -dictionary -index $index $data] 256 set lastsort($l) $tag 257 } else { 258 set result [lsort -decreasing -dictionary -index $index $data] 259 set lastsort($l) "" 260 } 261 set result1 {} 262 set i 0 263 foreach row $result { 264 lappend result1 [lreplace $row 0 0 " [incr i] "] 265 266 } 267 $l delete 0 end 268 eval $l insert end $result1 269} 270 271proc ::message_archive::delete_lastsort {id} { 272 variable lastsort 273 274 if {[info exists lastsort($id)]} { 275 unset lastsort($id) 276 } 277} 278 279proc ::message_archive::select_and_print_body {w l index} { 280 variable label 281 variable messages 282 283 $l selection clear 0 end 284 $l selection set $index 285 286 set id [lindex [$l get $index] 1] 287 if {$id == ""} { 288 return 289 } 290 291 $w.title.label configure -text $label($messages($id,dir)) 292 $w.title.jid configure -text $messages($id,fromto) 293 $w.subject.subj configure -text $messages($id,subject) 294 295 $w.sw.body configure -state normal 296 $w.sw.body delete 0.0 end 297 #$w.sw.body insert end $messages($id,body) 298 ::richtext::render_message $w.sw.body $messages($id,body) "" 299 $w.sw.body configure -state disabled 300} 301