#
#  Module Misc.tcl
#
#  $Log: Misc.tcl,v $
#  Revision 1.2  2006/10/26 09:39:17  vfom
#  Added code for netstate server query
#
#  Revision 1.1.1.1  2006/09/21 10:57:02  vfom
#  Loading TkNetmon to CVS
#
#
#  Miscellaneous procedures.
#

#---------------------------------------------------------------
#
# DL structure definition : 
#	set lst [list [list first second] ]    
#
#	lappend lst [list first second]
# 
# DLsecondByFirst-find element, where first part==name, return second part
#
proc DLsecondByFirst { lst name } {
    foreach i $lst { 
	if {[string equal $name [lindex $i 0]] } {
	    return [lindex $i 1]
	}	    
    }
    return {}
}
# DLfirstBySecond -find element, where second=name, return first part
#
proc DLfirstBySecond { lst name } {
    foreach i $lst { 
	if {[string equal $name [lindex $i 1]] } {
	    return [lindex $i 0]
	}	    
    }
    return {}
}
# DLfirstParameterList -for all elements, return first part
#
proc DLfirstParameterList { lst } {
    set tmp_list [list]
    foreach i $lst { lappend tmp_list [lindex $i 0 ] }
    return $tmp_list
}
# DLsecondParameterList -for all elements, return second part
#
proc DLsecondParameterList { lst } {
    set tmp_list [list]
    foreach i $lst { lappend tmp_list [lindex $i 1 ] }
    return $tmp_list
}
# DLdeleteByFirst - remove element where first part ==name
#
proc DLdeleteByFirst { lst name } {
    set tmp_list [list]
    foreach i $lst {
	if {[string equal $name [lindex $i 0] ]} { } else {
    	    lappend tmp_list $i 
	}
    }	    
    return $tmp_list
}
# DLdeleteBySecond - remove element where second part ==name
#
proc DLdeleteBySecond { lst name } {
    set tmp_list [list]
    foreach i $lst {
	if {[string equal $name [lindex $i 1] ]} { } else {
    	    lappend tmp_list $i 
	}	    
    }
    return $tmp_list
}
#---------------------------------------------------------------
#
# Usage: GetBodyInBraces {\s*proc\s+SomeProcName\s+\{\s*\}} $source_text 
#
#  $souce_text - plain text, whrere is 
#  .....................
#  proc SomeProcName { } {
#    some proc body text    
#  }
#  ....................
#
# 
proc GetBodyInBraces { reg_txt tbody } {
    set reg_txt "$reg_txt\\s+\{"
    set level    0
    set idxList {}
    if { ![regexp -indices -- $reg_txt $tbody idxList ] } {
	return {}
    }
    set result_start [lindex $idxList 1]
    set got true
    set tmp_start [expr $result_start +1]
    while {$got} {
	regexp -start $tmp_start -indices -- {[{}]} $tbody idxList
	set brace_idx [lindex $idxList 0]
	set chr "\\[string index $tbody $brace_idx]"
	if { $chr =={\{} } { incr level }
	if { $chr =={\}} } {
	    if {$level==0} {
		set got false
	    } else {
		set level [expr $level - 1]
	    }
	}
	set tmp_start [expr $brace_idx +1]
    }
    return [string range $tbody [expr $result_start+1] [expr $brace_idx-1]]
}
#
# Procedure checks, is curve braces balansed in plain text $example
#  If closing brace appear before any opening brace - resut=false
#
proc IsBracesBalanced { example } {
    regsub -all -- {[^{}]+} $example {} str
    set ubraces 0
    set len [ string length $str ]
    if { $len==0 } { return true }    
    for { set i 0 } { $i<$len } { incr i } {
	set ch [string index $str $i]
	set ch "\\$ch"
	# opening brace
	if { $ch== {\{} } {
	    incr ubraces 
	} elseif { $ch== {\}} } {
	    set ubraces [ expr $ubraces-1 ]
	}
	# closing brace first 
	if { $ubraces<0 } { return false }	    
    }
    if { $ubraces==0 } { return true }
    return false
}
#
# Procedire checks, if quotes balnced in plain text $example
#  Expected example consist of quited expressions separated by
#    spaces,tabs,CRs,NLs - not alptha chars, like this:
#     
#    set example {"one" "two two" "three parts" }
#
proc IsQuotesBalanced { example } {
    if { [ string length $example ]==0 } { return true }    
    regsub -all -- {"[^"]*"} $example {} str
    regsub -all -- {\s*} $str {} rezult
    if { $rezult=={} } { return true }         
    return false
}
#---------------------------------------------------------------
#
proc IsValidFont { fname } {
    if { ![ winfo exists .validate_font_tmp_label] } {
        label .validate_font_tmp_label -text XXX
    }
    if { [catch {.validate_font_tmp_label configure -font $fname} rez ] } {
	return false
    }
    return true
}
#
proc IsValidColor { cname } {
    if { ![ winfo exists .validate_color_tmp_label] } {
	label .validate_color_tmp_label -text XXX
    }
    if { [catch {.validate_color_tmp_label configure -foreground $cname} rez ] } { 
	return false 
    }
    return true
}
# 
proc IsValidCoordinate { crd } {
    if { [regsub -all {^(\+|\-)?[0-9]+\.?([0-9]+)?} $crd {} tmp_crd ] < 1 } { return false }
    regsub -all {\s} $tmp_crd {} tmp_crd2
    if { $tmp_crd2=="" } { return true }
    return false
}
#
proc IsValidLineWidth { wdt } {
    if { [regsub -all {[0-9]+\.?([0-9]+)?} $wdt {} tmp_wdt] < 1 } { return false }
    regsub -all {\s} $tmp_wdt {} tmp_wdt2
    if { $tmp_wdt2=="" } { return true }
    return false
}
#---------------------------------------------------------------


