# Library functions for the scripting library (scrib)
#
# File: scrib/lib/utils.tcl
#
# $Revision$ on $Date$
# 
# Copyright (c) 1993-2003 ICEM CFD Engineering
#
#--------------------------------------------------------------------
#
# --> if the name of the first proc already exists in interp, return
#
if {"" != [info commands scrib_lib_utils_native_path]} { return }
#
# --> procs in this file depend on the following scrib/lib/ files--source them
#     I guess we could do this by proc, too, not sure waht's best
#
#---------------------------------------------------------------------

## source the given list of files <em>filelist</em>.
## no path or extension should be on these files, e.g.:
##     "~scrib/lib/exec.tcl" should be listed as "exec"
## but it should work with them too...

proc scrib_lib_utils_source_files {filelist} {
    global env
    
    if ![info exists env(ICEM_SCRIB)] {
	mess "environment variable ICEM_SCRIB must be set"
	return
    }
    foreach f $filelist {
	set f [file tail [file rootname $f]]
	set file [file join $env(ICEM_SCRIB) lib ${f}.tcl]
	source "$file"
    }
}
if {"" != [info commands scrib_lib_setup_source_files]} {
    set required_files "exec"
    scrib_lib_setup_source_files $required_files
}

## get a path that windows can understand

proc scrib_lib_utils_native_path {path} {
    if [scrib_lib_utils_iswin] {    
	regsub -all \\\\ $path / path
    }
    return $path
}

## returns whether or not we are running on windoze

proc scrib_lib_utils_iswin {} {
    global is_win tcl_platform
    
    if [info exists is_win] {
	return $is_win
    }
    if [info exists tcl_platform(platform)] {
	set is_win [string compare $tcl_platform(platform) unix]
    } else {
	set is_win [expr ![file exists /etc/passwd]]
    }
    return $is_win
}

##

proc scrib_lib_utils_logfile {dir {pre ""}} {
    
    if {"" == $pre} {
	set pre "logfile"
    }
    
    set logbase [file join "$dir" "${pre}.[scrib_lib_utils_date_string]"]
    
    for {set i 0} {[file exists $logbase$i]} {incr i} {}
    return $logbase$i
}

## Slurp the contents of a file into a space-split list

proc scrib_lib_utils_slurp_file_into_list {file} {
    
    if ![file exists $file] {
	mess "Error: cannot get data from non-existent file: $file\n" red
	return ""
    }
    
    set fp [open $file r]
    set stuff [read $fp]
    close $fp
    
    return [split $stuff]
}

proc scrib_lib_utils_append_text_to_file {text file} {
    
    #if ![file exists $file] {
    #mess "Error: cannot append text to non-existent file: $file\n" red
    #}
    
    set fp [open $file a]
    puts $fp "\n$text"
    close $fp
}

##

proc scrib_lib_utils_remove_files_not_in_list {files_to_keep} {
    
    foreach f [glob -nocomplain -type f *] {
	if {0 >  [lsearch $files_to_keep $f]} {
	    catch {file delete -force -- $f}
	}
    }
}

## unused. it returns.

proc scrib_lib_utils_record_append {text {close 0}} { return }

## take a string <em>title</em> and make it something that
## would be a valid path for a tk widget.

proc scrib_lib_utils_string_to_path {title} {
    for {set i 0} {$i < [string length $title]} {incr i} {
	if ![string is alnum [string range $title $i $i]] {
	    set title [string replace $title $i $i _]
	}
    }
    return "_[string tolower $title]"
}

## needs doc.

proc scrib_lib_utils_string_pad_to_length {string length} {

    set curlen [string length $string]
    set diff [expr {$length - $curlen}]
    set padlen  [expr {1.0 * $diff / 2}]
    set pad1len [expr int([expr floor($padlen)])]
    set pad2len [expr int([expr  ceil($padlen)])]
    set pad1 [string repeat { } $pad1len]
    set pad2 [string repeat { } $pad2len]
    return "$pad1$string$pad2"
}

## needs doc.

proc scrib_lib_utils_strings_pad_equal {strings} {
    
    set brokenstrings ""
    foreach s $strings {
	if [string first "\n" $s] {
	    set st [split $s "\n"]
	    foreach s $st {
		lappend brokenstrings $s
	    }
	} else {
	    lappend brokenstrings $s
	}
    }

    # get maxstrlen
    set maxstrlen 0
    foreach s $brokenstrings {
	set curstrlen [string length $s]    
	if {$maxstrlen < $curstrlen} {
	    set maxstrlen $curstrlen
	}
    }
    
    # now pad each string to maxstrlen
    set newstrings ""
    foreach s $strings {
	lappend newstrings [scrib_lib_utils_string_pad_to_length $s $maxstrlen]
    }
    
    return $newstrings
}

## report a message to the current text widget.

proc scrib_lib_utils_report_message {text {color ""}} {
    scrib_lib_utils_record_append $text
    if {"mess" == [info commands mess]} {
	mess $text $color
    } else {
	puts $text
    }
}

## if debugging is on, put a debugging statement to the current
## text widget

proc scrib_lib_utils_putdebug {text} { }

## copy some one file to another in args

proc scrib_lib_utils_file_copy {args} {
    
    return [cmd_cp $args]
    # -- old -->
    if [catch {eval file copy -force -- $args} res] {
        return 0
    } else {
        return 1
    }
}

## Removes <i>element</i> from list <i>list</i>.

proc scrib_lib_utils_list_remove_element {list element} {
    set ind [lsearch $list $element]
    while {0 <= $ind} {
	set list [lreplace $list $ind $ind]
	set ind  [lsearch $list $element]
	# is this over-doing control-structure? --jka
	if {0 > $ind} { break }
    }
    return $list
}

## Removes duplicates from list of <i>names</i>.
## this is probably better than the one below
## this was taken out of med/lib/med_batch/util_funs.tcl
## if called from a scrib/scripts/*.tcl file, you can use it directly

proc scrib_lib_utils_list_remove_duplicate {names} {
     return [ic_remove_duplicate $names]
}

## For every non-unique element in given TCL list <em>list</em>,
## remove all instances. Note that this function returns the list sorted.
## this was taken out of med/lib/med_batch/util_funs.tcl
## if called from a scrib/scripts/*.tcl file, you can use it directly

proc scrib_lib_utils_list_remove_duplicated {list} {
    return [ic_list_remove_duplicated $list]
}

## Uniquify given given Tcl list <em>list</em>. Note that this function returns
## the list sorted.
## this was taken out of med/lib/med_batch/util_funcs.tcl
## if called from a scrib/scripts/*.tcl file, you can use it directly

proc scrib_lib_utils_list_uniquify {list} {
    return [lsort -unique $list]
}

## get the verbose string for the given number

proc scrib_lib_utils_verbose_number {ind} {
    set text_numbers [list zero one two three four five six seven eight nine ten eleven twelve thirteen fourteen]
    if {([llength $text_numbers] <= $ind) || ($ind < 0)} {
	mess "could not get verbose text for number $ind\n" red
	return $ind
    }
    return [lindex $text_numbers $ind]
}

## return a string of, well formatted, of the data in the array of the given name

proc scrib_lib_utils_format_array {given_array_name {print_to_this_array ""}} {
    
    global $given_array_name
    
    if ![array exists $given_array_name] {
	return ""
    }
    
    set formatted_string ""
    
    if {"" == $print_to_this_array} {
	set print_to_this_array $given_array_name
    }
    
    append formatted_string "array set $print_to_this_array \{\n"
    array set the_array [array get $given_array_name]
    foreach i [array names the_array] {
	if {"" == $the_array($i)} {
	    set val "\{\}"
	} elseif {1 < [llength $the_array($i)]} {
	    set val "\"$the_array($i)\""
	} else {
	    set val $the_array($i)
	}
	append formatted_string "\t$i $val\n"
    }
    append formatted_string "\}\n"
    
    return $formatted_string
}

## Try to ensure the same families in each the mesh and the geometry.
## This function cannot guarantee that the pids match.

proc scrib_lib_utils_ensure_same_families {} {
    
    set uns_fams [ic_uns_list_families]
    set geo_fams [ic_geo_list_families]
    foreach f $geo_fams {
	if {[lsearch $uns_fams $f] == -1} {ic_uns_new_family $f}
    }
    foreach f $uns_fams {
	if {[lsearch $geo_fams $f] == -1} {ic_geo_new_family $f}
    }

    if 0 { ic_validate_families }
}

## Needs doc

proc scrib_lib_utils_list_get_duplicate {list} {
     return [ic_list_get_duplicated $list]
}

## Needs doc

proc scrib_lib_utils_list_olists_remove_smaller_items {list dup} {
    set new_list $list
    foreach d $dup {
	set i 0
	foreach bs $list {
#mess "bs is $bs\n"
	    if {[lsearch $bs $d] != -1} {
		lappend dups [list $i [llength $bs]]
	    }
	    incr i
	}
#mess "dups is $dups\n"
	set dups [lsort -unique -index 1 -increasing -real $dups]
#mess "dups is $dups\n"
	set dups [lreplace $dups end end]
#mess "dups is $dups\n"
	set dups [lsort  -index 0 -decreasing -real $dups]
#mess "dups is $dups\n"
	foreach du $dups {
	    set ind [lindex $du 0]
	    set new_list [lreplace $new_list $ind $ind] 
	}
    }
    return $new_list
}


## Needs doc

proc scrib_lib_utils_list_olists_combine_dup_items {list {dup ""}} {
    if {$dup == ""} {
	#need to find duplicate items
	set dup [scrib_lib_utils_list_olists_get_duplicate $list]
    }
#find items in list that have duplicate items.
    if {$dup == ""}  {return $list}
    mess "duplicate items in $list are $dup\n" red
    set new_list ""
    set dup_list ""
    foreach l $list {
	set add 1
	foreach i $l {
	    if {[lsearch $dup $i] != -1} {set add 0}
	}
	if $add {
	    if {$new_list != ""} {
		lappend new_list $l
	    } else {
		set new_list [list $l]
	    }
#mess "new_list is $new_list\n"
	} else {
	    if {$dup_list != ""}  {
		lappend dup_list $l
	    } else {
		set dup_list [list $l]
	    }
#mess "dup_list is $dup_list\n"
	}
    }
    foreach d $dup {
	set i 0
	set combine ""
	set dups ""
	set cur_dup_list $dup_list
	set dup_list ""
	set add 1
	foreach ll $cur_dup_list {
	    if {[lsearch $ll $d] != -1} {
		set combine [lsort -unique [concat $combine $ll]]
	    } else {
		if {$dup_list != ""} {
		    lappend dup_list $ll
		} else {
		    set dup_list [list $ll]
		}	    
	    }
	}
	if {$combine != ""} {
	    if {$dup_list != ""} {
		lappend dup_list $combine
	    } else {
		set dup_list [list $combine]
	    }	
	}
    }
#mess "new_list is $new_list\n" blue
#mess "dup_list is $dup_list\n" green

    set new_list [concat $new_list $dup_list]
#mess "new_list is $new_list\n" blue
    set new_list [lsort -unique $new_list]
    return $new_list
}

proc scrib_lib_utils_list_olists_get_duplicate {list} {
    set all_items ""
    foreach li $list {set all_items [concat $all_items $li]}
    return [scrib_lib_utils_list_get_duplicate $all_items]
}


## Given /home/people/scrib_user/data ./wdir,
## this function would return /home/people/scrib_user/data/./wdir

proc scrib_lib_util_make_relative_path_absolute {base_path relative_path} {
    
    if {"" == $base_path} { return $relative_path }
    
    if [string equal "absolute" [file pathtype $relative_path]] {
	# well then it's misnamed as relative path...
	return $relative_path
    }
    
    if [string equal "relative" [file pathtype $relative_path]] {
	return [file join $base_path $relative_path]
    }
    
    return $relative_path
}

## This script is to return stuff from buttons

proc scrib_lib_utils_remove_from_grouped {groups free_surfs} {
    return [ic_list_remove_from_grouped $groups $free_surfs]
}

## 

proc scrib_lib_utils_files_in_directory {dir {extension ""} {allow_zipped 1}} {
    
    if [file isdirectory $dir] {
	#
	# --> if these files are in a specific directory, cd there
	#     save the starting directory path
	#
	# --> get a list (files) of all the files in the directory
	#     with the proper extension
	#
	if {"" != $extension} {
	    if $allow_zipped {
		set items [glob -nocomplain -type f [file join $dir *.$extension*]]
	    } else {
		set items [glob -nocomplain -type f [file join $dir *.$extension]]
	    }
	} else {
	    set items [glob -nocomplain -type f [file join $dir *]]
	}
	set files ""
	foreach item $items {
	    lappend files "$item"
	}
	return $files
	
    } elseif {(1 < [llength $dir]) && [file isfile [lindex $dir 0]]} {
	
	# then we have a file_list
	return $dir
	
    } elseif [file isfile $dir] {
	
	# then we have a file
	return $dir
    }
    
    mess "Error: finding files in $dir" red
    if {"" != $extension} { mess "with extension \"$extension\"" red } else { mess "\n" }
    
    return ""
}

##

proc scrib_lib_utils_unzip_files {files} {
    
    set result_files ""
    
    foreach f $files {
	set root       [file rootname  $f]
	set extension  [file extension $f]
	
	switch -- $extension {
	    "gz" {
		if [catch {exec gunzip $f} res] {
		    mess "Error: could not gunzip file $f: $res\n" red
		}
		lappend result_files "$root"
	    }
	    "zip" {
		if [catch {exec unzip $f} res] {
		    mess "Error: could not unzip file $f: $res\n" red
		}
		lappend result_files "$root"
	    }
	    default {
		lappend result_files "$f"
	    }
	}
    }
    
    return $result_files
}

proc scrib_lib_utils_unzip_file {file} {
    return [scrib_lib_utils_unzip_files $file]
}

##

proc scrib_lib_utils_zip_files {files mode} {
    
    foreach f $files {
	
	switch -- $mode {
	    "gz" - "gzip" {
		if [catch {exec gzip $f} res] {
		    mess "Error: could not gzip file $f: $res\n" red
		}
	    }
	    "zip" {
		if [catch {exec zip $f} res] {
		    mess "Error: could not zip file $f: $res\n" red
		}
	    }
	    "compress" - default {
		mess "Error: unsupported mode of files compression\n" red
	    }
	}
    }
}

proc scrib_lib_utils_zip_file {file mode} {
    return [scrib_lib_utils_zip_files $file $mode]
}

##

proc scrib_lib_utils_strip_down_list {list} {
    
    set nels [llength $list]
    while {1 == $nels} {
	set list [lindex $list  0]
	set nels [llength $list]
	if {1 < $nels} { break }
    }
    return $list
}

##

proc scrib_lib_utils_mkdir {dir} {
    
    if {"" != [info commands cmd_mkdir]} {
	return [cmd_mkdir $dir]
    } else {
	if [catch {file mkdir $dir} res] {
	    mess "$res\n" red
	    return 0
	} else {
	    return 1
	}	
    }
}

## Pour the contents of a file into the messages window

proc scrib_lib_utils_file_to_mess {file} {
    
    if ![file exists $file] {
	mess "Error: cannot get data from non-existent file: $file\n" red
    }
    
    set fp [open $file r]
    set stuff [read $fp]
    close $fp
    
    mess "$stuff\n" blue
}

## 

proc scrib_lib_utils_get_valid_token {token_els separator} {
    #
    # validate each of the elements of the nodes_list, then join with separataor
    #
    set valid_els ""
    foreach el $token_els {
	set val_el [scrib_lib_utils_validate_string $el]
	lappend valid_els $val_el
    }
    set token [join $valid_els $separator]
}

## Return the string with an underscore where a non-"wordchar" is found

proc scrib_lib_utils_validate_string {string} {
    
    while ![string is wordchar -failindex find $string] {
	set string [string replace $string $find $find "_"]
	if [string is wordchar -failindex find $string] {
	    break
	}
    }
    return $string
}

## Get a date string without any spaces in it

proc scrib_lib_utils_date_string {} {
    return [clock format [clock seconds] -format "%d_%b_%y_%H.%M.%S"]
    #return [string tolower [string map {" " "_"} [clock format [clock seconds]]]]
}




