# copyright (C) 1997-2001 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

set rcsId {$Id: utility.tcl,v 1.22 2000/12/31 23:14:19 jfontain Exp $}


proc commaSeparatedString {words} {
    for {set index 0} {$index<([llength $words]-1)} {incr index} {
        append string "[lindex $words $index], "
    }
    append string [lindex $words $index]
    return $string
}

proc startGatheringPackageDirectories {} {
    catch {rename source _source}
    proc source {file} {
        foreach name [package names] {
            set package($name) {}
        }
        uplevel _source [list $file]
        foreach name [package names] {                                                        ;# see what new packages are available
            if {![info exists package($name)]} {
                set ::packageDirectory($name) [file dirname $file]
            }
        }
    }
}

proc temporaryFileName {{extension {}} {identifier {}}} {
    if {[string length $identifier]==0} {
        set identifier [pid]                                                              ;# use process identifier as unique string
    }
    switch $::tcl_platform(platform) {
        macintosh {
            error {not implemented yet}
        }
        unix {
            foreach directory {/var/tmp /usr/tmp /tmp} {                                             ;# assume /tmp is always usable
                if {[file isdirectory $directory]&&[file writable $directory]} break
            }
        }
        windows {
            set directory c:/windows/temp
            catch {set directory $::env(TEMP)}
        }
    }
    set name [file join $directory moodss$identifier]
    if {[string length $extension]>0} {
        append name .$extension
    }
    return $name
}

proc linesCount {string} {
    return [llength [split $string \n]]
}

proc configureWritableTable {path} {                                                                           ;# table is a tktable
    bindtags $path [list $path [winfo toplevel $path] all]                     ;# remove all class bindings so they do not interfere
    foreach event {
        ButtonPress-1 B1-Motion ButtonRelease-1 Shift-1 Control-1 B1-Enter B1-Leave <Table_Commit> Shift-Up Shift-Down Shift-Left
        Shift-Right KeyPress BackSpace Delete Escape Alt-KeyPress Meta-KeyPress Control-KeyPress Any-Tab
    } {
        bind $path <$event> [bind Table <$event>]                                               ;# copy those class bindings to keep
    }
    bind $path <Return> {catch {%W activate active}}                                                       ;# validate cell contents
    bind $path <Enter> {catch {%W activate active}}
    bind $path <Left> [bind Table <Control-Left>]                                                  ;# keep cursor within active cell
    bind $path <Right> [bind Table <Control-Right>]
    bind $path <Home> [bind Table <Control-a>]
    bind $path <End> [bind Table <Control-e>]
    bind $path <Tab> [bind Table <Right>]                                                           ;# use tab to move between cells
    bind $path <Shift-Tab> [bind Table <Left>]
    if {[string equal $::tcl_platform(platform) unix]} {
        bind $path <ButtonRelease-2> {tk_tablePaste %W [%W index @%x,%y]}
    }
}

proc adjustTableColumns {table} {                               ;# automatically set column widths according to column cells content
    upvar #0 [$table cget -variable] data

    set label [label .temporary]        ;# use a temporary label for precise measurements, instead of using the font measure command
    set row [$table cget -roworigin]
    set lastRow [expr {$row+[$table cget -rows]}]
    set column [$table cget -colorigin]
    set lastColumn [expr {$column+[$table cget -cols]}]
    set defaultFont [$table cget -font]
    set titleFont [$table tag cget title -font]
    for {} {$column<$lastColumn} {incr column} {
        set maximum 0
        for {set row [$table cget -roworigin]} {$row<$lastRow} {incr row} {
            if {[string length [$table hidden $row,$column]]>0} continue                           ;# take hidden cell width as null
            if {[catch {set window [$table window cget $row,$column -window]}]} {
                if {[$table tag includes title $row,$column]} {
                    $label configure -font $titleFont
                } else {
                    $label configure -font $defaultFont
                }
                $label configure -text $data($row,$column)
                set width [winfo reqwidth $label]
            } else {
                set width [winfo reqwidth $window]
            }
            if {$width>$maximum} {
                set maximum $width
            }
        }
        $table width $column -$maximum
    }
    destroy $label
}

proc compareClocks {value1 value2} {
    set value1 [clock scan $value1 -base 0]
    set value2 [clock scan $value2 -base 0]
    if {$value1==$value2} {
        return 0
    } elseif {$value1<$value2} {
        return -1
    } else {
        return 1
    }
}
