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