### project Xcontrol
### HMI DN
### M. Fromme fromme@helmholtz-berlin.de
### June 1999

###
### general tools
###

proc itemize {s {schar ""}} {
  # split a string Perl-like
  if {$schar == ""} {
    set sp [split $s]
  } else {
    set sp [split $s $schar]
  }
  set res {}
  foreach e $sp {
    if {$e == ""} continue
    lappend res $e
  }
  return $res
}

proc padString {v n} {
  if {[string length $v] > 40} {
    return [string range $v 0 39]
  }
  return [format "%${n}s" $v]
}

proc padS {v {n 12}} {
  set fm "%${n}s"
  if {[set zlen [string first \n $v]] >= 0} {
    set fl [format $fm [string range $v 0 $zlen]]
    set sl [format $fm [string range $v [expr $zlen + 1] end]]
    return "$fl$sl"
  }
  if {[string length $v] > 40} {
    return [string range $v 0 39]
  }
  return [format $fm $v]
}

proc removeSubwindows {w} {
  if {![winfo exists $w]} return
  foreach wd [lsort -decreasing [split [winfo children $w]]] {
    destroy $wd
  }
}

proc incrF {v {delta 1}} {
  upvar $v x
  set x [expr $x + $delta]
}

proc getNumAndUnit {s ni ui} {
  upvar $ni n
  upvar $ui u
  set s [string trim $s]
  if {![regexp {(.+)([cm])$} $s a n u]} {
    set n $s
    set u _
  }
  if [catch {expr 0 + $n} n] {
    set n 0
  }
}

proc addNumUnitVals {a b} {
  getNumAndUnit $a an au
  getNumAndUnit $b bn bu
  switch $au$bu {
    _c - c_ - cc {return "[expr $an + $bn]c"}
    _m - m_ - mm {return "[expr $an + $bn]m"}
    cm      {return "[expr 10 * $an + $bn]m"}
    mc      {return "[expr $an + 10 * $bn]m"}
    default {return [expr $an + $bn]}
  }
}

### easy framing
###
proc lFrame w {
  global bgColor
  frame $w -bg $bgColor
  pack $w -side left -pady 1m
}

proc tFrame w {
  global bgColor
  frame $w -bg $bgColor
  pack $w -side top -fill both -padx 10
}

proc Frame {w {packexp no}} {
  global bgColor
  frame $w -bg $bgColor
  pack $w -side top -fill both -expand $packexp
}

proc fGroup {args} {
  global bgColor
  foreach g $args {frame $g -bg $bgColor}
  eval "pack $args -side top -fill both -expand yes"
}
proc mGroup {dy args} {
  global bgColor
  foreach g $args {
    frame $g -bg $bgColor
    pack  $g -side top -fill both -pady $dy
  }
}

proc scrollFrame {w side cw ch sh {sw ""}} {
  global bgColor
  if {$side == "both"} {
    set mf $w.modf
    frame $mf
    pack $mf -side top -fill both -expand yes
    set c $mf.c
    yscroll $mf "$c yview"
    if {$sw == ""} {set sw [addNumUnitVals $cw 4c] }
    canvas $c -width $cw -height $ch -bg $bgColor\
	-scrollregion [list 0 0 $sw $sh]\
	-xscrollcommand "$w.xscroll set" -yscrollcommand "$mf.yscroll set"
    pack $c -side left -expand yes -fill both
    xscroll $w "$c xview"
  } else {
    set c $w.c
    yscroll $w "$c yview" $side
    canvas $c -width $cw -height $ch -bg $bgColor\
	-scrollregion [list 0 0 $cw $sh]\
	-yscrollcommand "$w.yscroll set"
    pack $c -side $side -fill both -expand yes
  }
  set wmf $c.f
  frame $wmf -bg $bgColor -width $cw -height $ch
  $c create window 0 0 -window $wmf -anchor nw
  return $wmf
}

proc adjustScrollRegion {w {cw ""}} {

  set sw [winfo parent $w]
  # Adjust the scroll bar length to the real size of the scrolled window sw

  # find dimensions and sizes: update first
  update

  # if we do not have a content window cw, look for children's y position
  if {$cw == ""} {
    set y -1
    catch {
      set y [winfo y [lindex [winfo children $sw.f] end]]
    }
    if {$y <= 0} return
  } else {
    # find the real height of the content window cw
    set y  [winfo height $cw]
  }
  
  # configure canvas scroll region height to real value + 40 pixel
  $sw configure -scrollregion [lreplace [$sw cget -scrollregion] 3 3 [expr 40 + $y]]
}


proc lLabel {w {text ""}} {
  global labColor
  label $w.label -text $text -font [labelFont] -bg $labColor
  pack  $w.label -side top -fill both
}

proc sLabel {w {text ""}} {
  global labColor
  label $w.label -text $text -font [headerFont] -bg $labColor
  pack  $w.label -side top -fill both
}

proc helpLink {w s m {item ""}} {
  if {$item == ""} {set item $s}
  $w tag bind $m <ButtonPress> [list showHelpItem $item]
  $w insert end $s [list tl $m]
}

proc helpButton {w s m {item ""}} {
  global buttonColor
  if {$item == ""} {set item $s}
  button $w.$m -text $s -command [list showHelpItem $item]\
      -font [sbuttonFont] -background $buttonColor
  $w window create end -window $w.$m
}

proc helpFrame {w {mode ""}} {
  global bgColor buttonColor
  set w $w.helpframe
  frame $w
  pack $w -expand yes -fill both -padx 4
  set w $w.t
  text $w -relief raised \
      -height 100 -width 132\
      -font [textFont] -bg $bgColor\
      -wrap none
  pack $w -side left -expand yes -fill both -ipadx 1 -ipady 1

  $w tag configure tl -underline on -font [labelFont]

  helpButton $w {Getting Help} t5 Help
  $w insert end {

You can get help about every
  - parameter by clicking on its name (see also help for module)
  - module by clicking on the module number or choosing the menu Help

}
  helpLink $w Help t10
  $w insert end {

Alternativly, you can visit web pages at
}

  helpLink $w http://www.helmholtz-berlin.de/vitess t11
  $w insert end {

For further questions, please send an email to vitess@helmholtz-berlin.de

}

  helpButton $w {Getting Started} t20
  helpButton $w Tutorial t24 tutorial.pdf
  $w insert end \n
  helpButton $w {Inserting/Deleting a Module} t21
  helpButton $w {Visualising Results} t22
  $w insert end \n
  helpButton $w Troubleshooting t23
}


proc pLabel {w {text ""}} {
  global bgColor
  label $w.label -text $text -font [headerFont] -bg $bgColor
  pack  $w.label -side top -fill both -padx 0.5m -pady 0.5m
}

proc headLine {w text} {
  global bgColor
  label $w.headline -text $text -font [headerFont] -bg $bgColor
  pack  $w.headline -side top -fill both -padx 0.5m -pady 0.5m
}
proc bButton {w text command} {
  global buttonColor
  button $w -font [buttonFont] -text $text -command $command -background $buttonColor
}
proc bsButton {w text command} {
  global buttonColor
  button $w -font [sbuttonFont] -text $text -command $command -background $buttonColor
}
proc bPack {args} {
  foreach but $args {
    pack $but -side left -ipadx 1m
  }
}

proc dismissFrame {w {d dism}} {
  global bgColor
  frame $w.$d -bg $bgColor
  pack $w.$d -side bottom -fill x -pady 2m
  bButton $w.$d.dismiss Dismiss "destroy $w"
  pack $w.$d.dismiss -side left
}

proc printFrame {w} {
  global tcl_version
  if {$tcl_version < 8.5} {
    dismissFrame $w
    return
  }
  set f $w.dism
  frame $f
  pack $f -side bottom -fill x -pady 2m
  bButton $f.dismiss Dismiss "destroy $w"
  bButton $f.print Print "$w.c postscript -file xy.ps"
  label $f.l -text "to file xy.ps"
  pack $f.dismiss -side left
  pack $f.l $f.print -side right
}

###
### tools to set and check global variables
###
proc checkalldefs {} {
  global globalDescriptionSET
  set elist {}
  foreach g [lsort [info globals]] {
    if [string match *ESET $g] {
      lappend elist $g
    }
  }
  foreach mod $elist {
    puts "module : $mod"
    upvar #0 $mod m
    set nlist {}
    set olist {}
    foreach n $m {
      if {"" == [set name [lindex $n 0]]} continue
      if {"header" == [lindex $n 1]} continue
      if {[lsearch $nlist $name] == -1} {
	lappend nlist $name
      } else {
	puts "\tdouble name :$name:"
      }
      if {"" == [set opts [lindex $n 3]]} continue
      if {"" == [set opt [lindex $opts 3]]} continue
      if {[lsearch $olist $opt] == -1} {
	lappend olist $opt
      } else {
	puts "\tdouble option :$opt:"
      }
    }
    set lnl [llength $nlist]
    puts "  $lnl [lsort $nlist]"
    set onl [llength $olist]
    puts "  $onl [lsort $olist]"
  }
}

### get value of global variable
###                if variable has not been defined, return ""
proc globVal {v} {
  upvar #0 $v locv
  if [info exists locv] {
    return $locv
  }
  return ""
}


### return 0 if v is part of args list
###
proc isNot {v args} {
  foreach t $args {
    if [string match $t $v] {
      return 0
    }
  }
  return 1
}

### if global variable a is not known, then define a with value val
# Hack: If the global variable belongs to an entry, we might have tried
#       to delete that beast earlier, but were able only to set its value
#       UNDEFINED. We treat these variables as unknown, and set the given
#       value then. 
###
proc forceDef {a val} {
  upvar #0 $a v
  if [info exists v] {
    if {$v != "UNDEFINED"} return
    # puts "DEBUG forceDef of UNDEFINED $a to $val"
  }
  set v $val
}
### force empty string definitions of global variables, if necessary
###
proc forceDefs {args} {
  foreach a $args {
    global $a
    if [info exists $a] continue
    set $a ""
  }
}
### short form to set global variable
###
proc gSet {a {b ""}} {
  global $a
  set $a $b
}

proc gsetBlank {args} {
  foreach a $args {
    global $a
    set $a {}
  }
}

###
### split a string given by a global variable name to a list.
### return unique items.
### "b a c b" becomes {a b c}

proc stringToSet {s} {
  set list {}; set e ""
  foreach l [lsort [split $s]] {
    if {$e != $l} {
      lappend list $l
    }
    set e $l
  }
  return $list
}

proc addToSet {set v} {
  upvar $set s
  if {[lsearch $s $v] == -1} {
    lappend s $v
  }
}

### return list of all globals which
### 1. are not defined internally by Tcl/Tk (may change)
### 2. do not start with an uppercase letter or .
### 3. do not end with SET or Add
### 4. do not belong to inactive modules after the last active one
### 5. are not in a list of temporary variables
### 6. are not in a list of of taboo variables
### 7. are not an array variable
###
proc savableGlobals {} {
  global maxModule DummyEntry TempVars DoNotSave DoNotSaveRegexp SaveInstrmode
  set lasti 0
  for {set i 1} {$i <= $maxModule} {incr i} {
    set varName mod$i
    upvar #0 $varName var
    if {![info exists var] || $var == $DummyEntry} continue
    set lasti $i
  }
  set l {}
  foreach e [info globals] {

    if [regexp $DoNotSaveRegexp $e] continue

    if [regexp {_([0-9]+)$} $e a n] {
      if {$n > $lasti} continue
    }
    if {[lsearch $TempVars $e] >= 0} continue
    if {[lsearch $DoNotSave $e] >= 0} continue
    if {$SaveInstrmode == "normal"} {
       if [regexp {^series.+_$} $e] continue
       if [regexp {^(mod|num)series_$} $e] continue
    }
    global $e
    if {[catch {array size $e} size] || !$size} {
      lappend l $e
    }
  }
  return $l
}

### return list of all globals which
### 1. are not defined internally by Tcl/Tk (may change)
### 2. do not start with an uppercase letter or .
### 3. do not end with SET or Add
### 4. do not belong to modules
### 5. are not in a list of temporary variables
### 6. are not in a list of of taboo variables
### 7. are not an array variable
###

proc isSavableSetting {e} {
  global TempVars DoSaveSetting DoNotSaveSetting DoNotSaveSettingRegexp
  if {[lsearch $DoSaveSetting $e] >= 0} {return 1}
  if [regexp $DoNotSaveSettingRegexp $e] {return 0}
  if [regexp {_([0-9]+)$} $e a n] {return 0}
  if {[lsearch $TempVars $e] >= 0} {return 0}
  if {[lsearch $DoNotSaveSetting $e] >= 0} {return 0}
  return 1
}

proc savableSettings {} {
  set l {}
  foreach e [info globals] {
    if [isSavableSetting $e] {
      global $e
      if {[catch {array size $e} size] || !$size} {
        lappend l $e
      }
    }
  }
  return $l
}


proc nextNumItems {f n result} {
  upvar $result ores
  set res {}
  set read 0
  while {[gets $f line] >= 0} {
    set line [string trim $line]
    if {$line == ""} continue
    switch [set i [scan $line "%g%g%g%g%g%g%g%g%g%g" n1 n2 n3 n4 n5 n6 n7 n8 n9 n10]] {
      10 {lappend res $n1 $n2 $n3 $n4 $n5 $n6 $n7 $n8 $n9 $n10}
      9 {lappend res $n1 $n2 $n3 $n4 $n5 $n6 $n7 $n8 $n9}
      8 {lappend res $n1 $n2 $n3 $n4 $n5 $n6 $n7 $n8}
      7 {lappend res $n1 $n2 $n3 $n4 $n5 $n6 $n7}
      6 {lappend res $n1 $n2 $n3 $n4 $n5 $n6}
      5 {lappend res $n1 $n2 $n3 $n4 $n5}
      4 {lappend res $n1 $n2 $n3 $n4}
      3 {lappend res $n1 $n2 $n3}
      2 {lappend res $n1 $n2}
      1 {lappend res $n1}
      default {set i 0}
    }
    if {[incr read $i] >= $n} break
  }
  set ores {}
  foreach i $res {
    set ti [expr int($i)]
    if {$ti == $i} {
      lappend ores $ti
    } else {
      lappend ores $i
    }
  }
  return $read
}

proc readNumItems {f alist app} {
  foreach l $alist {
    upvar #0 $l$app $l

  }
  set l [llength $alist]
  if {[nextNumItems $f $l ni] >= $l} {
    foreach it $alist n $ni {
      set $it $n
    }
    return 1
  }
  return 0
}

###
### re-poll a callback
###
proc rePoll {callback} {
  global polls_ Protfile
  if {$Protfile != ""} {flush $Protfile}
  if {1 != [scan $polls_ "%f" poll]} {
    set polls_ 1
    after 1000 $callback
    return
  }
  if {$polls_ < 0.5} {set polls_ 0.5}
  if {$polls_ > 10} {set polls_ 10}
  after [expr int(1000 * $polls_)] $callback
}

###
### protocol utilities
###
###

### open protocol file
### try to use default parameter directory

proc openProtfile {{mode a+}} {
  global Protfile ProtfileName defdirectory_

  set dayname "Xc[clock format [clock seconds] -format "%Y%j"].log"
  set fn [file join $defdirectory_ $dayname]
  if [info exists ProtfileName] {
    if {$ProtfileName == $fn && $Protfile != ""} return
    if {$Protfile != ""} {
      close $Protfile
    }
  }
  set Protfile ""
  if [catch {open $fn $mode} Protfile] {
    # current directory is not writeable, so use Unix home or C:
    if {[getSystem] == "unix"} {set fn "~/"} else {set fn "C:/"}
    append fn $dayname
    if [catch {open $fn $mode} Protfile] {
      showText "!unable to open protocol file"
      set Protfile ""
      return
    }
  }
  set ProtfileName $fn
}


proc closeProtfile {} {
  global Protfile
  if {$Protfile == ""} return
  close $Protfile
  set Protfile ""
}
proc flushProtfile {} {
  global Protfile
  if {$Protfile != ""} {
    flush $Protfile
  }
}

proc outProtocol {text {simu 0}} {
  if {$simu} {
    set text "SIMUL $text"
  }
  global Protfile
  if {$Protfile == ""} {
    showText $text
    return
  }
  set text [showText $text]
  catch {
    puts $Protfile "[clock format [clock seconds] -format "%d.%m.%Y %H:%M:%S"] $text"
  }
}

proc conditionalOpenProtfile {} {
  global ProtocolMode
  if {$ProtocolMode != "nothing"} openProtfile
}

proc conditionalCloseProtfile {} {
  global ProtocolMode
  if {$ProtocolMode == "action"} closeProtfile
}

proc dontDoit text {
  global LastState
  set newState [generateVitessCommand kstate]
  if {$newState == "" || $LastState == $newState} {return 0}
  # puts "compare states\n$LastState\n and\n$newState"
  set rc [tk_messageBox -icon question -type yesno -title "confirmed command" -message $text]
  if {$rc == "no"} {return 1}
  return 0
}

proc confirmedCommand {command args {text ""}} {
  if {$text == ""} {
    set text "$command $args ?"
  }
  if [dontDoit $text] return
  switch $command {
    mkdir   {eval file mkdir $args}
    cp      {eval file copy $args}
    default {eval "$command $args"}
  }
}

proc selectCommand {
  yescommand
  yestext
  nocommand
  notext
  {text "Please Select"}
} {
  if [tk_dialog .confirmbox Alternative $text questhead 0 $yestext $notext] {
    eval $nocommand
  } else {
    eval $yescommand
  }
}

proc tabOut {f args} {
  set os ""
  foreach a $args {
    if {[string length $a] > 7} {
      append os "$a\t"
    } else {
      append os "$a\t\t"
    }
  }
  puts $f $os
}

###
### add selected items to a list
###
proc addToVars {w selentry sublist glist} {
  upvar #0 $selentry sel
  upvar #0 $sublist sellist
  upvar #0 $glist list
  foreach i [$w.l.list curselection] {
    addToSet sellist [lindex $list $i]
  }
  global tk_version
  if {$tk_version < 4.0} {
    $w.l.list select clear
  } else {
    $w.l.list selection clear 0 end
  }
  set sel [join $sellist]
}


proc startHeavyExecution {} {
  global HEAVY
  set HEAVY 1
}
proc checkHeavyExecution {} {
  update
  global HEAVY
  return $HEAVY
}
proc stopHeavyExecution {} {
  global HEAVY
  set HEAVY 0
}

proc randomInit {{seed 0}} {
  global rand
  set rand(ia) 9301
  set rand(ic) 49297
  set rand(im) 233280
  set rand(seed) $seed
}
proc randomV {} {
  global rand
  if {![info exists rand]} randomInit
  set rand(seed) [expr $rand(seed)*$rand(ia) + $rand(ic) % $rand(im)]
  return [expr $rand(seed)/double($rand(im))]
}
proc randomRange {{range 1000}} {
  global rand
  return [expr int([randomV]*$range)]
}

proc getSystem {} {
  global tcl_platform
  return $tcl_platform(platform)
}

proc getFullTmpFile {fn} {
  if {[getSystem] != "windows"} {
    return "/tmp/$fn"
  }
  set d [globVal defdirectory_]
  if {$d == "" || ! [file isdirectory $d]} {
    set d C:/temp
    # create C:/temp if not existing
    if [catch {file mkdir $d}] {
      return $fn
    }
  }
  return [file join $d $fn]
}

proc tmpFilename {{name temp.tmp}} {
  global env
  set n USER
  foreach w {LOGNAME USERNAME} {
    if [catch {set n $env($w)}] continue
    break
  }
  set s [format %x [clock seconds]]
  return [getFullTmpFile [regsub -all {[^a-zA-Z0-9_.-]} "$n$s$name" ""]]
}

proc getDirectory {name} {
  if [file isdirectory $name] {return $name}
  return [file dirname $name]
}

proc parFileReadable {name app} {
  global defdirectory_
  return [file readable [file join $defdirectory_ [entryVal $name $app]]]
}


proc browseFile {{var dummy} access dirtype {ext ""} {mustexist false}} {
  set err 1
  if {$dirtype == "d"} {
    set err [catch {tk_chooseDirectory -mustexist $mustexist} name]
  }
  if $err {if {[set name [fileDialog $access $ext]] == ""} return}
  switch $dirtype {
    d {
      if {! [file isdirectory $name]} {
	# user has given a/b/c
	if [file exists $name] {
	  # a/b/c exists as plain file
	  # so we use a/b/
	  set name [file dirname $name]
	} else {
	  # uses tries to create directory a/b/c/
	  if [catch {file mkdir $name}] {
	    showText "unable to create directory $name"
	    return
	  }
	}
      }
    }
    p {
      set fname $name
      set name [file tail $name]
      if [file readable $fname] {
	global defdirectory_
	set rname [file join $defdirectory_ $name]
	if {$fname != $rname} {
	  if [file exists $rname] {
	    confirmedCommand cp "-force $fname $rname" \
		"Overwrite\n$name\nwith parameter file from\n$$defdirectory_"
	  } else {
	    confirmedCommand cp "$fname $rname" \
		"Copy parameter file\n$name from\n[file dirname $fname]\nto default directory"
	  }
	}
      }
    }
  }
  if {$var == "dummy"} {
    return $name
  }
  global $var
  set $var $name
}


proc saveFile {w fn {saveAs 0}} {
  if $saveAs {set fn [fileDialog write "" $fn]}

  if [catch {open $fn w} f] {
    showText "can't open $fn to write"
    return
  }
  puts $f [$w.v.text get 1.0 end]
  close $f
  destroy $w
}

proc openWriteFile {ext {sugg ""} {fname ""}} {
  if {$fname != ""} {upvar $fname n}
  set n [fileDialog write $ext $sugg]
  if {$n == ""} {return 0}
# code excluded, because fileDialog already asked if necessary
#  if {![catch {glob $n}]} {
#    if {[tk_dialog .confirmbox "confirm" \
#	     "replace file $n ?" questhead 0 replace cancel]} {
#      return 0
#    }
#  }
  if [catch {open $n w} f] {
    outProtocol "can't open $n to write"
    return 0
  }
  return $f
}

proc getFileDialogTypes {ext} {
  global fileDialogSET
  if {$fileDialogSET == ""} {set fileDialogSET {{"All files" *}}}
  if {$ext != ""} {
    # reorder types to have the selected type first
    set count [llength $fileDialogSET]
    for {set i 0} {$i < $count} {incr i} {
      set line [lindex $fileDialogSET $i]
      foreach t [lindex $line 1] {
	if {$t != ".$ext"} continue
	set fset [list $line]
	for {set j 0} {$j < $count} {incr j} {
	  if {$j == $i} continue
	  lappend fset [lindex $fileDialogSET $j]
	}
	return $fset
      }
    }
  }
  return $fileDialogSET
}

proc fDialog {operation ext ifile def} {
  if {$operation == "open"} {
    if {$def != ""} {
      return [tk_getOpenFile -initialdir $def]
    }
    return [tk_getOpenFile]
  }
  if {$ext == ""} {set ext txt}
  set ifile [file tail $ifile]
  if {$def != ""} {
    return [tk_getSaveFile -initialfile $ifile -defaultextension .$ext -initialdir $def]
  }
  return [tk_getSaveFile -initialfile $ifile -defaultextension .$ext]
}

proc deLall {fn} {
  # cut off double extensions, like a.txt.txt -> a.txt
  if [regexp {\.([^\.]+)$} $fn a n] {
    return [eval regsub {\.$n\.$n$} $fn .$n]
  }
  return $fn
}

proc fDialogTypes {operation ext ifile def types} {
  if {$operation == "open"} {
    if {$def != ""} {
      return [tk_getOpenFile -filetypes $types -initialdir $def]
    }
    return [tk_getOpenFile -filetypes $types]
  }
  if {$ext == ""} {set ext txt}
  set ifile [file tail $ifile]
  if {$def != ""} {
    set rc [tk_getSaveFile -filetypes $types  \
		-initialfile $ifile -defaultextension .$ext -initialdir $def]
    return [deLall $rc]
  }
  return [tk_getSaveFile -filetypes $types  \
	      -initialfile $ifile -defaultextension .$ext]
}

proc fileDialog {operation {ext ""} {ifile Untitled}} {
  global browse_ext_mode tcl_platform
  set def [entryVal defdirectory]
  if {$tcl_platform(os) == "Darwin" && $browse_ext_mode == "all"} {
    return [fDialog $operation $ext $ifile $def]
  }
  return [fDialogTypes $operation $ext $ifile $def [getFileDialogTypes $ext]]
}

proc getSerializeProc {ext} {
  set capvers "[string toupper [string range $ext 0 0]][string range $ext 1 2]"
  return [info commands serialize${capvers}File]
}

proc yscroll {w command {side right}} {
  global bgColor scrollWidth
  append w ".yscroll"
  scrollbar $w -command $command -bg $bgColor -width $scrollWidth
  pack $w -side $side -fill y
}

proc xscroll {w command {side top}} {
  global bgColor scrollWidth
  append w ".xscroll"
  scrollbar $w -command $command -bg $bgColor -width $scrollWidth -orient horizontal
  pack $w -side $side -fill x
}

proc isWritableDirectory {d} {
  if [file isdirectory $d] {
    # try to create a file in that directory
    set fn [file join $d dummy[clock seconds]]
    if [catch {open $fn w} f] {
      return 0
    }
    if [catch {puts $f a}] {
      close $f
      return 0
    }
    close $f
    file delete $fn
    return 1
  }
  return 0
}

proc newParamDirectory {oldname} {
  # generate a new parameter directory name
  global env
  set fn [file tail $oldname]
  set h $env(HOME)
  set nd [file join $h $fn]
  while 1 {
    if [file exists $nd] {
      set nd [file join $h ${fn}[incr i]]
    } else {
      if [catch {file mkdir $nd}] return ""
      return $nd
    }
  }
}

proc findWindowsFile {roota rootb np {maxlevel 4}} {
  set dirl [list $roota $rootb]
  set ff 0
  for {set i 0} {$i < $maxlevel} {incr i} {
    set lnew {}
    foreach d $dirl {
      set f [file join $d $np]
      catch {
        if [file exists $f] {set ff 1}
      }
      if {$ff} {return $f}
      set pat [file join $d *]
      if [catch {set ssi [glob -nocomplain -type d $pat]}] continue
      foreach dli $ssi {
        lappend lnew $dli
      }
    }
    if {[llength $lnew] <= 0} break
    set dirl $lnew
  }
  return ""
}

proc findFile {root name} {
  if {$name == "" || $root == ""} { return ""}
  set dirl [list $root]
  while 1 {
    set lnew {}
    foreach d $dirl {
      set f [file join $d $name]
      # puts "DEBUG look at $f"
      if [file exists $f] { 
        return $f
      }
      set pat [file join $d *]
      if [catch {set ssi [glob -nocomplain -type d $pat]}] continue
      foreach dli $ssi {
        lappend lnew $dli
      }
    }
    if {[llength $lnew] <= 0} break
    set dirl $lnew
  }
  return ""
}
