# $Id: message_archive.tcl 2099 2014-01-26 09:48:25Z sergei $

option add *Messages.listheight 10 widgetDefault

namespace eval ::message_archive {
    variable logdir [file join $::configdir logs]

    if {![file exists $logdir]} {
	file mkdir $logdir
    }

    variable archive_file [file join $logdir message_archive]
    variable label
    array set label [list to [::msgcat::mc "To:"] from [::msgcat::mc "From:"]]

    variable messages
}

#############################################################################

proc ::message_archive::str_to_log {str} {
    return [string map {\\ \\\\ \r \\r \n \\n} $str]
}

#############################################################################

proc ::message_archive::log_to_str {str} {
    return [string map {\\\\ \\ \\r \r \\n \n} $str]
}

#############################################################################

proc ::message_archive::log_message {from to subject body x} {
    variable archive_file

    set seconds [::xmpp::xml::getAttr [::xmpp::delay::parse $x] seconds]
    set ts [clock format $seconds -format "%Y%m%dT%H%M%S"]

    set fd [open $archive_file a]
    fconfigure $fd -encoding utf-8
    puts $fd [str_to_log [list timestamp $ts id $ts[rand 10000] from $from to $to subject $subject body $body]]
    close $fd
}

proc ::message_archive::show_archive {} {
    variable lastsort
    variable label
    variable messages

    set w .message_archive
    if {[winfo exists $w]} {
	return
    }

    add_win $w -title [::msgcat::mc "Messages"] \
	    -tabtitle [::msgcat::mc "Messages"] \
	    -class Messages \
	    -raise 1

    PanedWin $w.pw -side right -pad 0 -width 4
    pack $w.pw -fill both -expand yes

    set uw [PanedWinAdd $w.pw -weight 0 -minsize 100]
    set dw [PanedWinAdd $w.pw -weight 1 -minsize 100]

    frame $dw.title
    label $dw.title.label -text $label(from)
    label $dw.title.jid
    pack $dw.title -fill x
    pack $dw.title.label -side left
    pack $dw.title.jid -side left

    frame $dw.subject
    label $dw.subject.lsubj -text [::msgcat::mc "Subject:"]
    label $dw.subject.subj
    pack $dw.subject -fill x
    pack $dw.subject.lsubj -side left
    pack $dw.subject.subj -side left

    set body [ScrolledWindow $dw.sw]
    text $body.body -height 20 -state disabled -wrap word
    pack $body -expand yes -fill both -anchor nw
    $body setwidget $body.body
    ::richtext::config $body.body -using {url emoticon stylecode}

    set sww [ScrolledWindow $w.items]

    set height [option get $w listheight Messages]
    ::mclistbox::mclistbox $sww.listbox \
	    -resizeonecolumn 1 \
	    -labelanchor w \
	    -width 90 \
	    -height $height
    set l $sww.listbox 

    pack $sww -expand yes -fill both -anchor nw -in $uw
    $sww setwidget $l

    [winfo parent $uw] configure \
	-height [expr {int( 1.2*($height+1)*[font metrics [$l cget -font] -linespace] )}]


    set lastsort($l) ""
    bind $l <Destroy> +[list [namespace current]::delete_lastsort %W]

    bind $l <1> \
	    "[namespace current]::select_and_print_body \
	     [double% $dw] [double% $l] \[[double% $l] nearest \[::mclistbox::convert %W -y %y\]\]"

#    bind $l <<ContextMenu>> \
#	    "[namespace current]::select_and_popup_menu \
#	     [double% $l] \[[double% $l] nearest \[::mclistbox::convert %W -y %y\]\]"

    bindscroll $sww $l

    $l column add N -label " [::msgcat::mc #] "
    $l column add id -label "" -visible 0
    $l column add timestamp -label " [::msgcat::mc Received/Sent] "
    $l column add dir -label " [::msgcat::mc Dir] "
    $l column add fromto -label " [::msgcat::mc From/To] "
    $l column add subject -label " [::msgcat::mc Subject] "

    array unset messages

    foreach var {timestamp fromto subject} {
	$l label bind $var <ButtonPress-1> "[namespace current]::sort %W [double% $var]"
    }

    $l column add lastcol -label "" -width 0
    $l configure -fillcolumn lastcol

    fill_list $l

    $l see end
    select_and_print_body $dw $l end
}

proc ::message_archive::max {a b} {
    return [expr {$a > $b ? $a : $b}]
}

proc ::message_archive::fill_list {l} {
    variable archive_file
    
    if {![file exists $archive_file]} {
	return
    }

    foreach i {N timestamp dir fromto subject} {
	$l column configure $i -width [string length [$l column cget $i -label]]
    }

    set hist {}
    set fd [open $archive_file r]
    fconfigure $fd -encoding utf-8
    while {[gets $fd line] > 0} {
	catch {fill_row $l [log_to_str $line]}
    }
    close $fd
}

proc ::message_archive::fill_row {l var} {
    variable messages

    set connections [connections]
    if {[lempty $connections]} {
	set myjid ""
    } else {
	set myjid [connection_bare_jid [lindex $connections 0]]
    }

    foreach i {N id timestamp dir fromto subject} {
	set width($i) [$l column cget $i -width]
    }

    set rownum [$l size]
    incr rownum
    set row [list " $rownum "]
    set width(N) [max [string length " $rownum "] $width(N)]
    array unset tmp
    array set tmp $var
    if {[info exists tmp(id)]} {
	set id $tmp(id)
	lappend row $id
	set width(id) 0
    } else {
	return
    }
    if {[info exists tmp(timestamp)]} {
	set seconds [clock scan $tmp(timestamp) -gmt 0]
	set str " [clock format $seconds -format {%Y-%m-%d %X}] "
	lappend row $str
	set width(timestamp) [max [string length $str] $width(timestamp)]
    } else {
	lappend row {}
    }
    set q 0
    if {[info exists tmp(from)]} {
	set str [::xmpp::jid::stripResource $tmp(from)]
	if {$str == $myjid} {
	    set q 1
	    set fromto to
	    set dir " -> "
	    set messages($id,dir) to
	}
    } else {
	set tmp(from) {}
    }
    if {[info exists tmp(to)]} {
	set str [::xmpp::jid::stripResource $tmp(to)]
	if {$str == $myjid} {
	    set q 1
	    set fromto from
	    set dir " <- "
	    set messages($id,dir) from
	}
    } else {
	set tmp(to) {}
    }
    if {!$q} {
	return
    } else {
	lappend row $dir
	set str [::xmpp::jid::stripResource $tmp($fromto)]
	lappend row " $str "
	set width(fromto) [max [string length " $str "] $width(fromto)]
	set messages($id,fromto) $tmp($fromto)
    }
    if {[info exists tmp(subject)]} {
	lappend row " $tmp(subject) "
	set width(subject) [max [string length " $tmp(subject) "] $width(subject)]
	set messages($id,subject) $tmp(subject)
    } else {
	lappend row {}
	set messages($id,subject) ""
    }
    if {[info exists tmp(body)]} {
	set messages($id,body) $tmp(body)
    } else {
	set messages($id,body) ""
    }
    $l insert end $row

    foreach i {N timestamp id dir fromto subject} {
	$l column configure $i -width $width($i)
    }
}

proc ::message_archive::sort {l tag} {
    variable lastsort

    set data [$l get 0 end]
    set index [lsearch -exact [$l column names] $tag]
    if {$lastsort($l) != $tag} {
	set result [lsort -dictionary -index $index $data]
	set lastsort($l) $tag
    } else {
	set result [lsort -decreasing -dictionary -index $index $data]
	set lastsort($l) ""
    }
    set result1 {}
    set i 0
    foreach row $result {
	lappend result1 [lreplace $row 0 0 " [incr i] "]

    }
    $l delete 0 end
    eval $l insert end $result1
}

proc ::message_archive::delete_lastsort {id} {
    variable lastsort

    if {[info exists lastsort($id)]} {
	unset lastsort($id)
    }
}

proc ::message_archive::select_and_print_body {w l index} {
    variable label
    variable messages

    $l selection clear 0 end
    $l selection set $index
    
    set id [lindex [$l get $index] 1]
    if {$id == ""} {
	return
    }

    $w.title.label configure -text $label($messages($id,dir))
    $w.title.jid configure -text $messages($id,fromto)
    $w.subject.subj configure -text $messages($id,subject)
    
    $w.sw.body configure -state normal
    $w.sw.body delete 0.0 end
    #$w.sw.body insert end $messages($id,body)
    ::richtext::render_message $w.sw.body $messages($id,body) ""
    $w.sw.body configure -state disabled
}
