# $Id: utils.tcl,v 1.24 2004/03/16 21:02:54 aleksey Exp $

proc user_from_jid {jid} {
    set user $jid
    regexp {(.*@.*)/.*} $jid temp user

    return $user
}

proc node_and_server_from_jid {jid} {
    set nas $jid
    regexp {([^/]*)/.*} $jid temp nas

    return $nas
}

proc server_from_jid {jid} {
    set serv $jid
    regexp {([^/]*)/.*} $jid temp serv
    regexp {[^@]*@(.*)} $serv temp serv

    return $serv
}

proc resource_from_jid {jid} {
    set resource ""
    regexp {[^/]*/(.*)} $jid temp resource

    return $resource
}

proc node_from_jid {jid} {
    set node ""
    regexp {([^@]*)@.*} $jid temp node
    #debugmsg utils "Node($jid) = $node"

    return $node
}


proc tolower_node_and_domain {jid} {
    
    set nas [string tolower [node_and_server_from_jid $jid]]
    set resource [resource_from_jid $jid]

    if {![cequal $resource ""]} {
	return $nas/$resource
    } else {
	return $nas
    }
    
}



proc win_id {prefix key} {
    global wins

    if {![info exists wins(seq,$prefix)]} {
	set wins(seq,$prefix) 0
    }

    if {![info exists wins(key,$prefix,$key)]} {
	set idx $wins(seq,$prefix)
	set wins(key,$prefix,$key) ".${prefix}_$idx"
	incr wins(seq,$prefix)
    }
    return $wins(key,$prefix,$key)
}


proc jid_to_tag {jid} {
    variable jidtag
    variable tagjid
    
    if {[info exists jidtag($jid)]} {
	return $jidtag($jid)
    } else {
	set tag [join [lmatch -regexp [split $jid {}] \
			   {^[[:alpha:]]$}] {}][random 1000000000]

	while {[info exists tagjid($tag)]} {
	    set tag [join [lmatch -regexp [split $jid {}] \
			       {^[[:alpha:]]$}] {}][random 1000000000]
	}

	set jidtag($jid) $tag
	set tagjid($tag) $jid

	return $tag
    }
}

proc tag_to_jid {tag} {
    variable tagjid

    if {[info exists tagjid($tag)]} {
	return $tagjid($tag)
    } else {
	error "Unknown tag $tag"
    }
}

proc double% {str} {
    regsub -all % $str %% res
    return $res
}

proc error_type_condition {errmsg} {
    return [lrange [jlib::error_to_list $errmsg] 0 1]
}

proc error_to_string {errmsg} {
    return [lindex [jlib::error_to_list $errmsg] 2]
}

proc get_group_nick {jid fallback} {
    global defaultnick

    set nick $fallback
    set tmp_pattern *
    foreach pattern [array names defaultnick] {
	if {[string equal $pattern $jid]} {
	    return $defaultnick($pattern)
	} elseif {([string match $pattern $jid]) && ([string match $tmp_pattern $pattern])} {
	    set nick $defaultnick($pattern)
	    set tmp_pattern $pattern
	}
    }
    return $nick
}

proc check_message {nick body} {
    set prefixes {"" "2"}
    set suffixes {":" any " " any "" end}

    foreach pref $prefixes {
	foreach {suff pos} $suffixes {
	    set str "$pref$nick$suff"
	    if {[cequal $body $str] || \
		    ([cequal [crange $body 0 [expr {[clength $str] - 1}]] $str] && \
		    [cequal $pos any])} {
		set l [clength $pref]
		return [list 1 [list $l [expr {$l + [clength $nick]}]]]
	    }
	}
    }
    return {0 {}}
}

proc format_time {t} {
	if {[cequal $t ""]} {
	    return
	}

	set sec [expr {$t % 60}]
	set secs [expr {($sec==1)?"[msgcat::mc second]":"[msgcat::mc seconds]"}]
	set t [expr {$t / 60}]
	set min [expr {$t % 60}]
	set mins [expr {($min==1)?"[msgcat::mc minute]":"[msgcat::mc minutes]"}]
	set t [expr {$t / 60}]
	set hour [expr {$t % 24}]
	set hours [expr {($hour==1)?"[msgcat::mc hour]":"[msgcat::mc hours]"}]
	set day [expr {$t / 24}]
	set days [expr {($day==1)?"[msgcat::mc day]":"[msgcat::mc days]"}]

	set flag 0
	set message ""
	if {$day != 0} {
		set flag 1
		set message "$day $days"
	}
	if {$flag || ($hour != 0)} {
		set flag 1
		set message [concat $message "$hour $hours"]
	}
	if {$flag || ($min != 0)} {
		set message [concat $message "$min $mins"]
	}

	return [concat $message "$sec $secs"]
}

proc NonmodalMessageDlg {path args} {

    set icon "none"
    set title ""
    set message ""
    set opts {}
    set mopts {}
    foreach {option value} $args {
	switch -- $option {
	    -icon {
		set icon $value
		if { $value != "none" } {
		    set image [Bitmap::get $value]
		} else {
		    set image ""
		}
	    }
	    -title {
		set title $value
	    }
	    -aspect {
		lappend mopts $option $value
	    }
	    -message {
		lappend mopts -text $value
	    }
	    default {
		lappend opts $option $value
	    }
	}
    }

    set frame [frame $path -class MessageDlg]
    set title [option get $frame "${icon}Title" MessageDlg]
    destroy $frame
    if { $title == "" } {
	set title "Message"
    }

    eval Dialog::create $path $opts -image $image -modal none -title $title \
            -side bottom -anchor c -default 0 -cancel 0
    Dialog::add $path -text [::msgcat::mc "OK"] -name ok -command "destroy $path"

    set frame [Dialog::getframe $path]
    eval message $frame.msg $mopts -relief flat -borderwidth 0 -highlightthickness 0 \
	    -textvariable {{}}
    pack  $frame.msg -side left -padx 3m -pady 1m -fill x -expand yes
    
    Dialog::draw $path
}

proc bindscroll {w {w1 ""}} {

    if {[cequal $w1 ""]} {
	set w1 $w
    }
    bind $w <4> \
	"if {\[lindex \[$w1 yview\] 0\] > 0} {
	    $w1 yview scroll -5 units
	 }"
    bind $w <5> \
	"if {\[lindex \[$w1 yview\] 1\] < 1} {
	    $w1 yview scroll 5 units
	 }"
    bind $w <6> \
	"if {\[lindex \[$w1 xview\] 0\] > 0} {
	    $w1 xview scroll -1 units
	 }"
    bind $w <7> \
	"if {\[lindex \[$w1 xview\] 1\] < 1} {
	    $w1 xview scroll 1 units
	 }"
}

proc Spinbox {path from to incr textvar} {
    
    if {[info tclversion] >= 8.4} {
	return [spinbox $path -from $from -to $to -increment $incr \
		    -buttoncursor left_ptr \
		    -textvariable $textvar]
    } else {
	return [SpinBox $path -range [list $from $to $incr] \
			-textvariable $textvar]
    }
}

proc focus_next {path fr} {
    focus [Widget::focusNext $path]
    set widget [focus]
    if {[string first $fr $widget] == 0} {
	$fr see $widget
    }
}

proc focus_prev {path fr} {
    focus [Widget::focusPrev $path]
    $fr see [focus]
}

proc CbDialog {path title buttons var lnames lballoons args} {
    upvar #0 $var result
    array set names $lnames
    array set balloons $lballoons

    set modal none
    set radio 0
    foreach {opt val} $args {
	switch -- $opt {
	    -type { set radio [cequal $val radio] }
	    -modal { set modal $val }
	}
    }

    set len [llength $buttons]

    Dialog $path -title $title \
        -modal $modal -separator 1 -anchor e -default 0 \
	-cancel [expr {[llength $buttons]/2 - 1}]

    foreach {but com} $buttons {
	$path add -text $but -command $com
    }

    set sw [ScrolledWindow [$path getframe].sw]
    set sf [ScrollableFrame $sw.sf -constrainedwidth yes]
    pack $sw -expand yes -fill both
    $sw setwidget $sf
    set sff [$sf getframe]

    bind $path <Key-Up> [list focus_prev %W $sf]
    bind $path <Key-Down> [list focus_next %W $sf]
    bind $path <Key-Tab> [list focus_next %W $sf]
    bind $path <Shift-Tab> [list focus_prev %W $sf]
    bind $path <<PrevWindow>> [list focus_prev %W $sf]
    bindscroll $sff $sf

    if {!$radio} {
	catch { array unset result }
    }

    foreach idx [array names names] {
	set temp($names($idx)) $idx
    }

    set i 0
    foreach idxt [lsort -dictionary [array names temp]] {
	set idx $temp($idxt)
	if {$radio} {
	    set cb [radiobutton $sff.cb$i -variable $var \
	                -text $names($idx) -value $idx]
	    if {$i == 0} {
		set result $idx
	    }

	} else {
	    set result($idx) 0
	    set cb [checkbutton $sff.cb$i -variable ${var}($idx) \
		-text $names($idx)]
	}
	bind $cb <Return> [list $path invoke 0]
	bind $cb <Return> +break
	bind $cb <1> [list focus %W]
	bindscroll $cb $sf
	if {[info exists balloons($idx)]} {
	    bind $cb <Any-Enter>  [list balloon::default_balloon $cb enter  %X %Y \
				       $balloons($idx)]
	    bind $cb <Any-Motion> [list balloon::default_balloon $cb motion %X %Y \
				       $balloons($idx)]
	    bind $cb <Any-Leave>  [list balloon::default_balloon $cb leave  %X %Y]
	}
	pack $cb -anchor w
	incr i
    }
    
    $path draw $sff.cb0
}