# Module: SYSFunctions
# Tcl version: 7.3 (Tcl/Tk/XF)
# Tk version: 3.6
# XF version: $__lastrelease$
#

# module contents
global moduleList
global autoLoadList
set moduleList(SYSFunctions) { AlertBox AlertBoxFd AlertBoxFile AlertBoxInternal Alias FSBox FSBoxBindSelectOne FSBoxFSFileSelect FSBoxFSFileSelectDouble FSBoxFSInsertPath FSBoxFSNameComplete FSBoxFSShow GetSelection HistoryTextBox InputBoxInternal InputBoxMulti InputBoxOne IsADir IsAFile IsASymlink TextBox TextBoxFd TextBoxFile TextBoxInternal VersionAlertBox YesNoBox Unalias ColorBox}
set autoLoadList(SYSFunctions) {0}

# procedures to show toplevel windows


# User defined procedures


# Procedure: AlertBox
proc AlertBox { {alertBoxMessage "Alert message"} {alertBoxCommand ""} {alertBoxGeometry "350x150"} {alertBoxTitle "Alert box"} args} {
# xf ignore me 5
##########
# Procedure: AlertBox
# Description: show alert box
# Arguments: {alertBoxMessage} - the text to display
#            {alertBoxCommand} - the command to call after ok
#            {alertBoxGeometry} - the geometry for the window
#            {alertBoxTitle} - the title for the window
#            {args} - labels of buttons
# Returns: The number of the selected button, ot nothing
# Sideeffects: none
# Notes: there exist also functions called:
#          AlertBoxFile - to open and read a file automatically
#          AlertBoxFd - to read from an already opened filedescriptor
##########
#
# global alertBox(activeBackground) - active background color
# global alertBox(activeForeground) - active foreground color
# global alertBox(after) - destroy alert box after n seconds
# global alertBox(anchor) - anchor for message box
# global alertBox(background) - background color
# global alertBox(font) - message font
# global alertBox(foreground) - foreground color
# global alertBox(justify) - justify for message box
# global alertBox(toplevelName) - the toplevel name

  global alertBox

  # show alert box
  if {[llength $args] > 0} {
    eval AlertBoxInternal "\{$alertBoxMessage\}" "\{$alertBoxCommand\}" "\{$alertBoxGeometry\}" "\{$alertBoxTitle\}" $args
  } {
    AlertBoxInternal $alertBoxMessage $alertBoxCommand $alertBoxGeometry $alertBoxTitle
  }

  if {[llength $args] > 0} {
    # wait for the box to be destroyed
    update idletask
    grab $alertBox(toplevelName)
    tkwait window $alertBox(toplevelName)

    return $alertBox(button)
  }
}


# Procedure: AlertBoxFd
proc AlertBoxFd { {alertBoxInFile ""} {alertBoxCommand ""} {alertBoxGeometry "350x150"} {alertBoxTitle "Alert box"} args} {
# xf ignore me 5
##########
# Procedure: AlertBoxFd
# Description: show alert box containing a filedescriptor
# Arguments: {alertBoxInFile} - a filedescriptor to read. The descriptor
#                               is closed after reading
#            {alertBoxCommand} - the command to call after ok
#            {alertBoxGeometry} - the geometry for the window
#            {alertBoxTitle} - the title for the window
#            {args} - labels of buttons
# Returns: The number of the selected button, ot nothing
# Sideeffects: none
# Notes: there exist also functions called:
#          AlertBox - to display a passed string
#          AlertBoxFile - to open and read a file automatically
##########
#
# global alertBox(activeBackground) - active background color
# global alertBox(activeForeground) - active foreground color
# global alertBox(after) - destroy alert box after n seconds
# global alertBox(anchor) - anchor for message box
# global alertBox(background) - background color
# global alertBox(font) - message font
# global alertBox(foreground) - foreground color
# global alertBox(justify) - justify for message box
# global alertBox(toplevelName) - the toplevel name

  global alertBox

  # check file existance
  if {"$alertBoxInFile" == ""} {
    puts stderr "No filedescriptor specified"
    return
  }

  set alertBoxMessage [read $alertBoxInFile]
  close $alertBoxInFile

  # show alert box
  if {[llength $args] > 0} {
    eval AlertBoxInternal "\{$alertBoxMessage\}" "\{$alertBoxCommand\}" "\{$alertBoxGeometry\}" "\{$alertBoxTitle\}" $args
  } {
    AlertBoxInternal $alertBoxMessage $alertBoxCommand $alertBoxGeometry $alertBoxTitle
  }

  if {[llength $args] > 0} {
    # wait for the box to be destroyed
    update idletask
    grab $alertBox(toplevelName)
    tkwait window $alertBox(toplevelName)

    return $alertBox(button)
  }
}


# Procedure: AlertBoxFile
proc AlertBoxFile { {alertBoxFile ""} {alertBoxCommand ""} {alertBoxGeometry "350x150"} {alertBoxTitle "Alert box"} args} {
# xf ignore me 5
##########
# Procedure: AlertBoxFile
# Description: show alert box containing a file
# Arguments: {alertBoxFile} - filename to read
#            {alertBoxCommand} - the command to call after ok
#            {alertBoxGeometry} - the geometry for the window
#            {alertBoxTitle} - the title for the window
#            {args} - labels of buttons
# Returns: The number of the selected button, ot nothing
# Sideeffects: none
# Notes: there exist also functions called:
#          AlertBox - to display a passed string
#          AlertBoxFd - to read from an already opened filedescriptor
##########
#
# global alertBox(activeBackground) - active background color
# global alertBox(activeForeground) - active foreground color
# global alertBox(after) - destroy alert box after n seconds
# global alertBox(anchor) - anchor for message box
# global alertBox(background) - background color
# global alertBox(font) - message font
# global alertBox(foreground) - foreground color
# global alertBox(justify) - justify for message box
# global alertBox(toplevelName) - the toplevel name

  global alertBox

  # check file existance
  if {"$alertBoxFile" == ""} {
    puts stderr "No filename specified"
    return
  }

  if {[catch "open $alertBoxFile r" alertBoxInFile]} {
    puts stderr "$alertBoxInFile"
    return
  }

  set alertBoxMessage [read $alertBoxInFile]
  close $alertBoxInFile

  # show alert box
  if {[llength $args] > 0} {
    eval AlertBoxInternal "\{$alertBoxMessage\}" "\{$alertBoxCommand\}" "\{$alertBoxGeometry\}" "\{$alertBoxTitle\}" $args
  } {
    AlertBoxInternal $alertBoxMessage $alertBoxCommand $alertBoxGeometry $alertBoxTitle
  }

  if {[llength $args] > 0} {
    # wait for the box to be destroyed
    update idletask
    grab $alertBox(toplevelName)
    tkwait window $alertBox(toplevelName)

    return $alertBox(button)
  }
}


# Procedure: AlertBoxInternal
proc AlertBoxInternal { alertBoxMessage alertBoxCommand alertBoxGeometry alertBoxTitle args} {
# xf ignore me 6
  global alertBox

  set tmpButtonOpt ""
  set tmpFrameOpt ""
  set tmpMessageOpt ""
  if {"$alertBox(activeBackground)" != ""} {
    append tmpButtonOpt "-activebackground \"$alertBox(activeBackground)\" "
  }
  if {"$alertBox(activeForeground)" != ""} {
    append tmpButtonOpt "-activeforeground \"$alertBox(activeForeground)\" "
  }
  if {"$alertBox(background)" != ""} {
    append tmpButtonOpt "-background \"$alertBox(background)\" "
    append tmpFrameOpt "-background \"$alertBox(background)\" "
    append tmpMessageOpt "-background \"$alertBox(background)\" "
  }
  if {"$alertBox(font)" != ""} {
    append tmpButtonOpt "-font \"$alertBox(font)\" "
    append tmpMessageOpt "-font \"$alertBox(font)\" "
  }
  if {"$alertBox(foreground)" != ""} {
    append tmpButtonOpt "-foreground \"$alertBox(foreground)\" "
    append tmpMessageOpt "-foreground \"$alertBox(foreground)\" "
  }

  # start build of toplevel
  if {"[info commands XFDestroy]" != ""} {
    catch {XFDestroy $alertBox(toplevelName)}
  } {
    catch {destroy $alertBox(toplevelName)}
  }
  toplevel $alertBox(toplevelName)  -borderwidth 0
  catch "$alertBox(toplevelName) config $tmpFrameOpt"
  if {[catch "wm geometry $alertBox(toplevelName) $alertBoxGeometry"]} {
    wm geometry $alertBox(toplevelName) 350x150
  }
  wm title $alertBox(toplevelName) $alertBoxTitle
  wm maxsize $alertBox(toplevelName) 1000 1000
  wm minsize $alertBox(toplevelName) 100 100
  # end build of toplevel

  message $alertBox(toplevelName).message1  -anchor "$alertBox(anchor)"  -justify "$alertBox(justify)"  -relief raised  -text "$alertBoxMessage"
  catch "$alertBox(toplevelName).message1 config $tmpMessageOpt"

  set xfTmpWidth  [string range $alertBoxGeometry 0 [expr [string first x $alertBoxGeometry]-1]]
  if {"$xfTmpWidth" != ""} {
    # set message size
    catch "$alertBox(toplevelName).message1 configure  -width [expr $xfTmpWidth-10]"
  } {
    $alertBox(toplevelName).message1 configure  -aspect 1500
  }

  frame $alertBox(toplevelName).frame1  -borderwidth 0  -relief raised
  catch "$alertBox(toplevelName).frame1 config $tmpFrameOpt"

  set alertBoxCounter 0
  set buttonNum [llength $args]
  if {$buttonNum > 0} {
    while {$alertBoxCounter < $buttonNum} {
      button $alertBox(toplevelName).frame1.button$alertBoxCounter  -text "[lindex $args $alertBoxCounter]"  -command "
          global alertBox
          set alertBox(button) $alertBoxCounter
          if {\"\[info commands XFDestroy\]\" != \"\"} {
            catch {XFDestroy $alertBox(toplevelName)}
          } {
            catch {destroy $alertBox(toplevelName)}
          }"
      catch "$alertBox(toplevelName).frame1.button$alertBoxCounter config $tmpButtonOpt"

      pack append $alertBox(toplevelName).frame1  $alertBox(toplevelName).frame1.button$alertBoxCounter {left fillx expand}

      incr alertBoxCounter
    }
  } {
    button $alertBox(toplevelName).frame1.button0  -text "OK"  -command "
        global alertBox
        set alertBox(button) 0
        if {\"\[info commands XFDestroy\]\" != \"\"} {
          catch {XFDestroy $alertBox(toplevelName)}
        } {
          catch {destroy $alertBox(toplevelName)}
        }
        $alertBoxCommand"
    catch "$alertBox(toplevelName).frame1.button0 config $tmpButtonOpt"

    pack append $alertBox(toplevelName).frame1  $alertBox(toplevelName).frame1.button0 {left fillx expand}
  }

  # packing
  pack append $alertBox(toplevelName)  $alertBox(toplevelName).frame1 {bottom fill}  $alertBox(toplevelName).message1 {top fill expand}

  if {$alertBox(after) != 0} {
    after [expr $alertBox(after)*1000]  "catch \"$alertBox(toplevelName).frame1.button0 invoke\""
  }
}


# Procedure: FSBox
proc FSBox { {fsBoxMessage "Select file:"} {fsBoxFileName ""} {fsBoxActionOk ""} {fsBoxActionCancel ""}} {
# xf ignore me 5
##########
# Procedure: FSBox
# Description: show file selector box
# Arguments: fsBoxMessage - the text to display
#            fsBoxFileName - a file name that should be selected
#            fsBoxActionOk - the action that should be performed on ok
#            fsBoxActionCancel - the action that should be performed on cancel
# Returns: the filename that was selected, or nothing
# Sideeffects: none
##########
# 
# global fsBox(activeBackground) - active background color
# global fsBox(activeForeground) - active foreground color
# global fsBox(background) - background color
# global fsBox(font) - text font
# global fsBox(foreground) - foreground color
# global fsBox(extensions) - scan directory for extensions
# global fsBox(scrollActiveForeground) - scrollbar active background color
# global fsBox(scrollBackground) - scrollbar background color
# global fsBox(scrollForeground) - scrollbar foreground color
# global fsBox(scrollSide) - side where scrollbar is located

  global fsBox

  set tmpButtonOpt ""
  set tmpFrameOpt ""
  set tmpMessageOpt ""
  set tmpScaleOpt ""
  set tmpScrollOpt ""
  if {"$fsBox(activeBackground)" != ""} {
    append tmpButtonOpt "-activebackground \"$fsBox(activeBackground)\" "
  }
  if {"$fsBox(activeForeground)" != ""} {
    append tmpButtonOpt "-activeforeground \"$fsBox(activeForeground)\" "
  }
  if {"$fsBox(background)" != ""} {
    append tmpButtonOpt "-background \"$fsBox(background)\" "
    append tmpFrameOpt "-background \"$fsBox(background)\" "
    append tmpMessageOpt "-background \"$fsBox(background)\" "
  }
  if {"$fsBox(font)" != ""} {
    append tmpButtonOpt "-font \"$fsBox(font)\" "
    append tmpMessageOpt "-font \"$fsBox(font)\" "
  }
  if {"$fsBox(foreground)" != ""} {
    append tmpButtonOpt "-foreground \"$fsBox(foreground)\" "
    append tmpMessageOpt "-foreground \"$fsBox(foreground)\" "
  }
  if {"$fsBox(scrollActiveForeground)" != ""} {
    append tmpScrollOpt "-activeforeground \"$fsBox(scrollActiveForeground)\" "
  }
  if {"$fsBox(scrollBackground)" != ""} {
    append tmpScrollOpt "-background \"$fsBox(scrollBackground)\" "
  }
  if {"$fsBox(scrollForeground)" != ""} {
    append tmpScrollOpt "-foreground \"$fsBox(scrollForeground)\" "
  }

  if {[file exists [file tail $fsBoxFileName]] &&
      [IsAFile [file tail $fsBoxFileName]]} {
    set fsBox(name) [file tail $fsBoxFileName]
  } {
    set fsBox(name) ""
  }
  if {[file exists $fsBoxFileName] && [IsADir $fsBoxFileName]} {
    set fsBox(path) $fsBoxFileName
  } {
    if {"[file rootname $fsBoxFileName]" != "."} {
      set fsBox(path) [file rootname $fsBoxFileName]
    }
  }
  if {$fsBox(showPixmap)} {
    set fsBox(path) [string trimleft $fsBox(path) @]
  }
  if {"$fsBox(path)" != "" && [file exists $fsBox(path)] &&
      [IsADir $fsBox(path)]} {
    set fsBox(internalPath) $fsBox(path)
  } {
    if {"$fsBox(internalPath)" == "" ||
        ![file exists $fsBox(internalPath)]} {
      set fsBox(internalPath) [pwd]
    }
  }
  # build widget structure

  # start build of toplevel
  if {"[info commands XFDestroy]" != ""} {
    catch {XFDestroy .fsBox}
  } {
    catch {destroy .fsBox}
  }
  toplevel .fsBox  -borderwidth 0
  catch ".fsBox config $tmpFrameOpt"
  wm geometry .fsBox 350x300 
  wm title .fsBox {File select box}
  wm maxsize .fsBox 1000 1000
  wm minsize .fsBox 100 100
  # end build of toplevel

  label .fsBox.message1  -anchor c  -relief raised  -text "$fsBoxMessage"
  catch ".fsBox.message1 config $tmpMessageOpt"

  frame .fsBox.frame1  -borderwidth 0  -relief raised
  catch ".fsBox.frame1 config $tmpFrameOpt"

  button .fsBox.frame1.ok  -text "OK"  -command "
      global fsBox
      set fsBox(name) \[.fsBox.file.file get\]
      if {$fsBox(showPixmap)} {
        set fsBox(path) @\[.fsBox.path.path get\]
      } {
        set fsBox(path) \[.fsBox.path.path get\]
      }
      set fsBox(internalPath) \[.fsBox.path.path get\]
      $fsBoxActionOk
      if {\"\[info commands XFDestroy\]\" != \"\"} {
        catch {XFDestroy .fsBox}
      } {
        catch {destroy .fsBox}
      }"
  catch ".fsBox.frame1.ok config $tmpButtonOpt"

  button .fsBox.frame1.rescan  -text "Rescan"  -command {
      global fsBox
      FSBoxFSShow [.fsBox.path.path get]  [.fsBox.pattern.pattern get] $fsBox(all)}
  catch ".fsBox.frame1.rescan config $tmpButtonOpt"

  button .fsBox.frame1.cancel  -text "Cancel"  -command "
      global fsBox
      set fsBox(name) {}
      set fsBox(path) {}
      $fsBoxActionCancel
      if {\"\[info commands XFDestroy\]\" != \"\"} {
        catch {XFDestroy .fsBox}
      } {
        catch {destroy .fsBox}
      }"
  catch ".fsBox.frame1.cancel config $tmpButtonOpt"

  if {$fsBox(showPixmap)} {
    frame .fsBox.frame2  -borderwidth 0  -relief raised
    catch ".fsBox.frame2 config $tmpFrameOpt"

    scrollbar .fsBox.frame2.scrollbar3  -command {.fsBox.frame2.canvas2 xview}  -orient {horizontal}  -relief {raised}
    catch ".fsBox.frame2.scrollbar3 config $tmpScrollOpt"

    scrollbar .fsBox.frame2.scrollbar1  -command {.fsBox.frame2.canvas2 yview}  -relief {raised}
    catch ".fsBox.frame2.scrollbar1 config $tmpScrollOpt"

    canvas .fsBox.frame2.canvas2  -confine {true}  -relief {raised}  -scrollregion {0c 0c 20c 20c}  -width {100}  -xscrollcommand {.fsBox.frame2.scrollbar3 set}  -yscrollcommand {.fsBox.frame2.scrollbar1 set}
    catch ".fsBox.frame2.canvas2 config $tmpFrameOpt"

    .fsBox.frame2.canvas2 addtag currentBitmap withtag [.fsBox.frame2.canvas2 create bitmap 5 5 -anchor nw]
  }

  frame .fsBox.path  -borderwidth 0  -relief raised
  catch ".fsBox.path config $tmpFrameOpt"

  frame .fsBox.path.paths  -borderwidth 2  -relief raised
  catch ".fsBox.path.paths config $tmpFrameOpt"

  menubutton .fsBox.path.paths.paths  -borderwidth 0  -menu ".fsBox.path.paths.paths.menu"  -relief flat  -text "Pathname:"
  catch ".fsBox.path.paths.paths config $tmpButtonOpt"

  menu .fsBox.path.paths.paths.menu
  catch ".fsBox.path.paths.paths.menu config $tmpButtonOpt"

  .fsBox.path.paths.paths.menu add command  -label "[string trimright $fsBox(internalPath) {/@}]"  -command "
       global fsBox
       FSBoxFSShow \[.fsBox.path.path get\]  \[.fsBox.pattern.pattern get\] \$fsBox(all)
       .fsBox.path.path delete 0 end
       .fsBox.path.path insert 0 [string trimright $fsBox(internalPath) {/@}]"

  entry .fsBox.path.path  -relief raised
  catch ".fsBox.path.path config $tmpMessageOpt"

  if {![IsADir $fsBox(internalPath)]} {
    set $fsBox(internalPath) [pwd]
  }
  .fsBox.path.path insert 0 $fsBox(internalPath)

  frame .fsBox.pattern  -borderwidth 0  -relief raised
  catch ".fsBox.pattern config $tmpFrameOpt"

  frame .fsBox.pattern.patterns  -borderwidth 2  -relief raised
  catch ".fsBox.pattern.patterns config $tmpFrameOpt"

  menubutton .fsBox.pattern.patterns.patterns  -borderwidth 0  -menu ".fsBox.pattern.patterns.patterns.menu"  -relief flat  -text "Selection pattern:"
  catch ".fsBox.pattern.patterns.patterns config $tmpButtonOpt"

  menu .fsBox.pattern.patterns.patterns.menu
  catch ".fsBox.pattern.patterns.patterns.menu config $tmpButtonOpt"

  .fsBox.pattern.patterns.patterns.menu add checkbutton  -label "Scan extensions"  -variable fsBoxExtensions  -command {
      global fsBox
      FSBoxFSShow [.fsBox.path.path get]  [.fsBox.pattern.pattern get] $fsBox(all)}

  entry .fsBox.pattern.pattern  -relief raised
  catch ".fsBox.pattern.pattern config $tmpMessageOpt"

  .fsBox.pattern.pattern insert 0 $fsBox(pattern)
  
  frame .fsBox.files  -borderwidth 0  -relief raised
  catch ".fsBox.files config $tmpFrameOpt"

  scrollbar .fsBox.files.vscroll  -relief raised  -command ".fsBox.files.files yview"
  catch ".fsBox.files.vscroll config $tmpScrollOpt"

  scrollbar .fsBox.files.hscroll  -orient horiz  -relief raised  -command ".fsBox.files.files xview"
  catch ".fsBox.files.hscroll config $tmpScrollOpt"

  listbox .fsBox.files.files  -exportselection false  -relief raised  -xscrollcommand ".fsBox.files.hscroll set"  -yscrollcommand ".fsBox.files.vscroll set"
  catch ".fsBox.files.files config $tmpMessageOpt"

  frame .fsBox.file  -borderwidth 0  -relief raised
  catch ".fsBox.file config $tmpFrameOpt"

  label .fsBox.file.labelfile  -relief raised  -text "Filename:"
  catch ".fsBox.file.labelfile config $tmpMessageOpt"

  entry .fsBox.file.file  -relief raised
  catch ".fsBox.file.file config $tmpMessageOpt"

  .fsBox.file.file delete 0 end
  .fsBox.file.file insert 0 $fsBox(name)
  
  checkbutton .fsBox.pattern.all  -offvalue 0  -onvalue 1  -text "Show all files"  -variable fsBox(all)  -command {
      global fsBox
      FSBoxFSShow [.fsBox.path.path get]  [.fsBox.pattern.pattern get] $fsBox(all)}
  catch ".fsBox.pattern.all config $tmpButtonOpt"

  FSBoxFSShow $fsBox(internalPath) $fsBox(pattern) $fsBox(all)

  # bindings
  bind .fsBox.files.files <Double-Button-1> "
    FSBoxFSFileSelectDouble %W $fsBox(showPixmap) \{$fsBoxActionOk\} %y"
  bind .fsBox.files.files <ButtonPress-1> "
    FSBoxFSFileSelect %W $fsBox(showPixmap) %y"
  bind .fsBox.files.files <Button1-Motion> "
    FSBoxFSFileSelect %W $fsBox(showPixmap) %y"
  bind .fsBox.files.files <Shift-Button1-Motion> "
    FSBoxFSFileSelect %W $fsBox(showPixmap) %y"
  bind .fsBox.files.files <Shift-ButtonPress-1> "
    FSBoxFSFileSelect %W $fsBox(showPixmap) %y"

  bind .fsBox.path.path <Tab> {
    FSBoxFSNameComplete path}
  bind .fsBox.path.path <Return> {
    global tkVersion
    global fsBox
    FSBoxFSShow [.fsBox.path.path get]  [.fsBox.pattern.pattern get] $fsBox(all)
    FSBoxFSInsertPath
    if {$tkVersion >= 3.0} {
      .fsBox.file.file icursor end
    } {
      .fsBox.file.file cursor end
    }
    focus .fsBox.file.file}
  catch "bind .fsBox.path.path <Up> {}"
  bind .fsBox.path.path <Down> {
    global tkVersion
    if {$tkVersion >= 3.0} {
      .fsBox.file.file icursor end
    } {
      .fsBox.file.file cursor end
    }
    focus .fsBox.file.file}

  bind .fsBox.file.file <Tab> {
    FSBoxFSNameComplete file}
  bind .fsBox.file.file <Return> "
    global fsBox
    set fsBox(name) \[.fsBox.file.file get\]
    if {$fsBox(showPixmap)} {
      set fsBox(path) @\[.fsBox.path.path get\]
    } {
      set fsBox(path) \[.fsBox.path.path get\]
    }
    set fsBox(internalPath) \[.fsBox.path.path get\]
    $fsBoxActionOk
    if {\"\[info commands XFDestroy\]\" != \"\"} {
      catch {XFDestroy .fsBox}
    } {
      catch {destroy .fsBox}
    }"
  bind .fsBox.file.file <Up> {
    global tkVersion
    if {$tkVersion >= 3.0} {
      .fsBox.path.path icursor end
    } {
      .fsBox.path.path cursor end
    }
    focus .fsBox.path.path}
  bind .fsBox.file.file <Down> {
    global tkVersion
    if {$tkVersion >= 3.0} {
      .fsBox.pattern.pattern icursor end
    } {
      .fsBox.pattern.pattern cursor end
    }
    focus .fsBox.pattern.pattern}

  bind .fsBox.pattern.pattern <Return> {
    global fsBox
    FSBoxFSShow [.fsBox.path.path get]  [.fsBox.pattern.pattern get] $fsBox(all)}
  bind .fsBox.pattern.pattern <Up> {
    global tkVersion
    if {$tkVersion >= 3.0} {
      .fsBox.file.file icursor end
    } {
      .fsBox.file.file cursor end
    }
    focus .fsBox.file.file}
  catch "bind .fsBox.pattern.pattern <Down> {}"

  # packing
  pack append .fsBox.files  .fsBox.files.vscroll "$fsBox(scrollSide) filly"  .fsBox.files.hscroll {bottom fillx}  .fsBox.files.files {left fill expand}
  pack append .fsBox.file  .fsBox.file.labelfile {left}  .fsBox.file.file {left fill expand}
  pack append .fsBox.frame1  .fsBox.frame1.ok {left fill expand}  .fsBox.frame1.rescan {left fill expand}  .fsBox.frame1.cancel {left fill expand}
  pack append .fsBox.path.paths  .fsBox.path.paths.paths {left}
  pack append .fsBox.pattern.patterns  .fsBox.pattern.patterns.patterns {left}
  pack append .fsBox.path  .fsBox.path.paths {left}  .fsBox.path.path {left fill expand}
  pack append .fsBox.pattern  .fsBox.pattern.patterns {left}  .fsBox.pattern.all {right fill}  .fsBox.pattern.pattern {left fill expand}
  if {$fsBox(showPixmap)} {
    pack append .fsBox.frame2  .fsBox.frame2.scrollbar1 {left filly}  .fsBox.frame2.canvas2 {top expand fill}  .fsBox.frame2.scrollbar3 {top fillx} 

    pack append .fsBox  .fsBox.message1 {top fill}  .fsBox.frame1 {bottom fill}  .fsBox.pattern {bottom fill}  .fsBox.file {bottom fill}  .fsBox.path {bottom fill}  .fsBox.frame2 {right fill}  .fsBox.files {left fill expand}
  } {
    pack append .fsBox  .fsBox.message1 {top fill}  .fsBox.frame1 {bottom fill}  .fsBox.pattern {bottom fill}  .fsBox.file {bottom fill}  .fsBox.path {bottom fill}  .fsBox.files {left fill expand}
  }

  if {"$fsBoxActionOk" == "" && "$fsBoxActionCancel" == ""} {
    # wait for the box to be destroyed
    update idletask
    grab .fsBox
    tkwait window .fsBox

    if {"[string trim $fsBox(path)]" != "" ||
        "[string trim $fsBox(name)]" != ""} {
      if {"[string trimleft [string trim $fsBox(name)] /]" == ""} {
        return [string trimright [string trim $fsBox(path)] /]
      } {
        return [string trimright [string trim $fsBox(path)] /]/[string trimleft [string trim $fsBox(name)] /]
      }
    }
  }
}


# Procedure: FSBoxBindSelectOne
proc FSBoxBindSelectOne { fsBoxW fsBoxY} {
# xf ignore me 6

  set fsBoxNearest [$fsBoxW nearest $fsBoxY]
  if {$fsBoxNearest >= 0} {
    $fsBoxW select from $fsBoxNearest
    $fsBoxW select to $fsBoxNearest
  }
}


# Procedure: FSBoxFSFileSelect
proc FSBoxFSFileSelect { fsBoxW fsBoxShowPixmap fsBoxY} {
# xf ignore me 6
  global fsBox

  FSBoxBindSelectOne $fsBoxW $fsBoxY
  set fsBoxNearest [$fsBoxW nearest $fsBoxY]
  if {$fsBoxNearest >= 0} {
    set fsBoxTmpEntry [$fsBoxW get $fsBoxNearest]
    if {"[string index $fsBoxTmpEntry  [expr [string length $fsBoxTmpEntry]-1]]" == "/" ||
        "[string index $fsBoxTmpEntry  [expr [string length $fsBoxTmpEntry]-1]]" == "@"} {
      set fsBoxFileName [string range $fsBoxTmpEntry 0  [expr [string length $fsBoxTmpEntry]-2]]
      if {![IsADir [string trimright $fsBox(internalPath)/$fsBoxFileName @]] &&
          ![IsASymlink [string trimright $fsBox(internalPath)/$fsBoxFileName @]]} {
        set fsBoxFileName $fsBoxTmpEntry
      }
    } {
      if {"[string index $fsBoxTmpEntry  [expr [string length $fsBoxTmpEntry]-1]]" == "*"} {
        set fsBoxFileName [string range $fsBoxTmpEntry 0  [expr [string length $fsBoxTmpEntry]-2]]
        if {![file executable $fsBox(internalPath)/$fsBoxFileName]} {
          set fsBoxFileName $fsBoxTmpEntry
        }
      } {
        set fsBoxFileName $fsBoxTmpEntry
      }
    }
    if {![IsADir [string trimright $fsBox(internalPath)/$fsBoxFileName @]]} {
      set fsBox(name) $fsBoxFileName
      .fsBox.file.file delete 0 end
      .fsBox.file.file insert 0 $fsBox(name)
      if {$fsBoxShowPixmap} {
        catch ".fsBox.frame2.canvas2 itemconfigure currentBitmap -bitmap \"@$fsBox(internalPath)/$fsBox(name)\""
      }
    }
  }
}


# Procedure: FSBoxFSFileSelectDouble
proc FSBoxFSFileSelectDouble { fsBoxW fsBoxShowPixmap fsBoxAction fsBoxY} {
# xf ignore me 6
  global fsBox

  FSBoxBindSelectOne $fsBoxW $fsBoxY
  set fsBoxNearest [$fsBoxW nearest $fsBoxY]
  if {$fsBoxNearest >= 0} {
    set fsBoxTmpEntry [$fsBoxW get $fsBoxNearest]
    if {"$fsBoxTmpEntry" == "../"} {
      set fsBoxTmpEntry [string trimright [string trim $fsBox(internalPath)] "@/"]
      if {"$fsBoxTmpEntry" == ""} {
        return
      }
      FSBoxFSShow [file dirname $fsBoxTmpEntry]  [.fsBox.pattern.pattern get] $fsBox(all)
      .fsBox.path.path delete 0 end
      .fsBox.path.path insert 0 $fsBox(internalPath)
    } {
      if {"[string index $fsBoxTmpEntry  [expr [string length $fsBoxTmpEntry]-1]]" == "/" ||
          "[string index $fsBoxTmpEntry  [expr [string length $fsBoxTmpEntry]-1]]" == "@"} {
        set fsBoxFileName [string range $fsBoxTmpEntry 0  [expr [string length $fsBoxTmpEntry]-2]]
        if {![IsADir [string trimright $fsBox(internalPath)/$fsBoxFileName @]] &&
            ![IsASymlink [string trimright $fsBox(internalPath)/$fsBoxFileName @]]} {
          set fsBoxFileName $fsBoxTmpEntry
        }
      } {
        if {"[string index $fsBoxTmpEntry  [expr [string length $fsBoxTmpEntry]-1]]" == "*"} {
          set fsBoxFileName [string range $fsBoxTmpEntry 0  [expr [string length $fsBoxTmpEntry]-2]]
          if {![file executable $fsBox(internalPath)/$fsBoxFileName]} {
            set fsBoxFileName $fsBoxTmpEntry
          }
        } {
          set fsBoxFileName $fsBoxTmpEntry
        }
      }
      if {[IsADir [string trimright $fsBox(internalPath)/$fsBoxFileName @]]} {
        set fsBox(internalPath) "[string trimright $fsBox(internalPath) {/@}]/$fsBoxFileName"
        FSBoxFSShow $fsBox(internalPath)  [.fsBox.pattern.pattern get] $fsBox(all)
        .fsBox.path.path delete 0 end
        .fsBox.path.path insert 0 $fsBox(internalPath)
      } {
        set fsBox(name) $fsBoxFileName
        if {$fsBoxShowPixmap} {
          set fsBox(path) @$fsBox(internalPath)
        } {
          set fsBox(path) $fsBox(internalPath)
        }
        if {"$fsBoxAction" != ""} {
          eval "global fsBox; $fsBoxAction"
        }
        if {"[info commands XFDestroy]" != ""} {
          catch {XFDestroy .fsBox}
        } {
          catch {destroy .fsBox}
        }
      }
    }
  }
}


# Procedure: FSBoxFSInsertPath
proc FSBoxFSInsertPath {} {
# xf ignore me 6
  global fsBox

  set fsBoxLast [.fsBox.path.paths.paths.menu index last]
  set fsBoxNewEntry [string trimright [.fsBox.path.path get] "/@"]
  for {set fsBoxCounter 0} {$fsBoxCounter <= $fsBoxLast} {incr fsBoxCounter 1} {
    if {"$fsBoxNewEntry" ==  "[lindex [.fsBox.path.paths.paths.menu entryconfigure  $fsBoxCounter -label] 4]"} {
      return
    }
  }
  if {$fsBoxLast < 9} {
    .fsBox.path.paths.paths.menu add command  -label "$fsBoxNewEntry"  -command "
        global fsBox
        FSBoxFSShow $fsBoxNewEntry  \[.fsBox.pattern.pattern get\] \$fsBox(all)
        .fsBox.path.path delete 0 end
        .fsBox.path.path insert 0 $fsBoxNewEntry"
  } {
    for {set fsBoxCounter 0} {$fsBoxCounter < $fsBoxLast} {incr fsBoxCounter 1} {
      .fsBox.path.paths.paths.menu entryconfigure  $fsBoxCounter -label  [lindex [.fsBox.path.paths.paths.menu entryconfigure  [expr $fsBoxCounter+1] -label] 4]
      .fsBox.path.paths.paths.menu entryconfigure $fsBoxCounter  -command "
          global fsBox
          FSBoxFSShow [lindex [.fsBox.path.paths.paths.menu entryconfigure  [expr $fsBoxCounter+1] -label] 4]  \[.fsBox.pattern.pattern get\] \$fsBox(all)
          .fsBox.path.path delete 0 end
          .fsBox.path.path insert 0 [lindex  [.fsBox.path.paths.paths.menu entryconfigure  [expr $fsBoxCounter+1] -label] 4]"
    }
    .fsBox.path.paths.paths.menu entryconfigure $fsBoxLast  -label "$fsBoxNewEntry"
    .fsBox.path.paths.paths.menu entryconfigure $fsBoxCounter  -command "
        global fsBox
        FSBoxFSShow \[.fsBox.path.path get\]  \[.fsBox.pattern.pattern get\] \$fsBox(all)
        .fsBox.path.path delete 0 end
        .fsBox.path.path insert 0 $fsBoxNewEntry"
  }
}


# Procedure: FSBoxFSNameComplete
proc FSBoxFSNameComplete { fsBoxType} {
# xf ignore me 6
  global tkVersion
  global fsBox

  set fsBoxNewFile ""
  if {"$fsBoxType" == "path"} {
    set fsBoxDirName [file dirname [.fsBox.path.path get]]
    set fsBoxFileName [file tail [.fsBox.path.path get]]
  } {
    set fsBoxDirName [file dirname [.fsBox.path.path get]/]
    set fsBoxFileName [file tail [.fsBox.file.file get]]
  }

  set fsBoxNewFile ""
  if {[IsADir [string trimright $fsBoxDirName @]]} {
    catch "glob -nocomplain $fsBoxDirName/${fsBoxFileName}*" fsBoxResult
    foreach fsBoxCounter $fsBoxResult {
      if {"$fsBoxNewFile" == ""} {
        set fsBoxNewFile [file tail $fsBoxCounter]
      } {
        if {"[string index [file tail $fsBoxCounter] 0]" !=
            "[string index $fsBoxNewFile 0]"} {
          set fsBoxNewFile ""
          break
        }
        set fsBoxCounter1 0
        set fsBoxTmpFile1 $fsBoxNewFile
        set fsBoxTmpFile2 [file tail $fsBoxCounter]
        set fsBoxLength1 [string length $fsBoxTmpFile1]
        set fsBoxLength2 [string length $fsBoxTmpFile2]
        set fsBoxNewFile ""
        if {$fsBoxLength1 > $fsBoxLength2} {
          set fsBoxLength1 $fsBoxLength2
        }
        while {$fsBoxCounter1 < $fsBoxLength1} {
          if {"[string index $fsBoxTmpFile1 $fsBoxCounter1]" ==  "[string index $fsBoxTmpFile2 $fsBoxCounter1]"} {
            append fsBoxNewFile [string index $fsBoxTmpFile1 $fsBoxCounter1]
          } {
            break
          }
          incr fsBoxCounter1 1
        }
      }
    }
  }
  if {"$fsBoxNewFile" != ""} {
    if {[IsADir [string trimright $fsBoxDirName/$fsBoxNewFile @]] ||
        ![IsAFile [string trimright $fsBoxDirName/$fsBoxNewFile @]]} {
      if {[IsADir [string trimright $fsBoxDirName/$fsBoxNewFile @]]} {
        if {"$fsBoxDirName" == "/"} {
          .fsBox.path.path delete 0 end
          .fsBox.path.path insert 0 "/[string trimright [string trim $fsBoxNewFile /] @]/"
        } {
          .fsBox.path.path delete 0 end
          .fsBox.path.path insert 0 "[string trimright $fsBoxDirName /]/[string trimright [string trim $fsBoxNewFile /] @]/"
        }
        FSBoxFSShow [.fsBox.path.path get]  [.fsBox.pattern.pattern get] $fsBox(all)
        FSBoxFSInsertPath
      } {
        .fsBox.path.path delete 0 end
        .fsBox.path.path insert 0 "[string trimright $fsBoxDirName /]/[string trimright [string trim $fsBoxNewFile /] @]"
      }
    } {
      .fsBox.path.path delete 0 end
      .fsBox.path.path insert 0 "[string trimright $fsBoxDirName {@/}]/"
      .fsBox.file.file delete 0 end
      .fsBox.file.file insert 0 $fsBoxNewFile
      if {$tkVersion >= 3.0} {
        .fsBox.file.file icursor end
      } {
        .fsBox.file.file cursor end
      }
      focus .fsBox.file.file
    }
  }
}


# Procedure: FSBoxFSShow
proc FSBoxFSShow { fsBoxPath fsBoxPattern fsBoxAll} {
# xf ignore me 6
  global fsBox

  set tmpButtonOpt ""
  if {"$fsBox(activeBackground)" != ""} {
    append tmpButtonOpt "-activebackground \"$fsBox(activeBackground)\" "
  }
  if {"$fsBox(activeForeground)" != ""} {
    append tmpButtonOpt "-activeforeground \"$fsBox(activeForeground)\" "
  }
  if {"$fsBox(background)" != ""} {
    append tmpButtonOpt "-background \"$fsBox(background)\" "
  }
  if {"$fsBox(font)" != ""} {
    append tmpButtonOpt "-font \"$fsBox(font)\" "
  }
  if {"$fsBox(foreground)" != ""} {
    append tmpButtonOpt "-foreground \"$fsBox(foreground)\" "
  }

  set fsBox(pattern) $fsBoxPattern
  if {[file exists $fsBoxPath] && [file readable $fsBoxPath] &&
      [IsADir $fsBoxPath]} {
    set fsBox(internalPath) $fsBoxPath
  } {
    if {[file exists $fsBoxPath] && [file readable $fsBoxPath] &&
        [IsAFile $fsBoxPath]} {
      set fsBox(internalPath) [file dirname $fsBoxPath]
      .fsBox.file.file delete 0 end
      .fsBox.file.file insert 0 [file tail $fsBoxPath]
      set fsBoxPath $fsBox(internalPath)
    } {
      while {"$fsBoxPath" != "" && "$fsBoxPath" != "/" &&
             ![file isdirectory $fsBoxPath]} {
        set fsBox(internalPath) [file dirname $fsBoxPath]
         set fsBoxPath $fsBox(internalPath)
      }
    }
  }
  if {"$fsBoxPath" == ""} {
    set fsBoxPath "/"
    set fsBox(internalPath) "/"
  }
  .fsBox.path.path delete 0 end
  .fsBox.path.path insert 0 $fsBox(internalPath)

  if {[.fsBox.files.files size] > 0} {
    .fsBox.files.files delete 0 end
  }
  if {$fsBoxAll} {
    if {[catch "exec ls -F -a $fsBoxPath" fsBoxResult]} {
      puts stderr "$fsBoxResult"
    }
  } {
    if {[catch "exec ls -F $fsBoxPath" fsBoxResult]} {
      puts stderr "$fsBoxResult"
    }
  }
  set fsBoxElementList [lsort $fsBoxResult]

  foreach fsBoxCounter [winfo children .fsBox.pattern.patterns.patterns] {
    if {[string length [info commands XFDestroy]] > 0} {
      catch {XFDestroy $fsBoxCounter}
    } {
      catch {destroy $fsBoxCounter}
    }
  }
  menu .fsBox.pattern.patterns.patterns.menu
  catch ".fsBox.pattern.patterns.patterns.menu config $tmpButtonOpt"

  if {$fsBox(extensions)} {
    .fsBox.pattern.patterns.patterns.menu add command  -label "*"  -command {
        global fsBox
        set fsBox(pattern) "*"
        .fsBox.pattern.pattern delete 0 end
        .fsBox.pattern.pattern insert 0 $fsBox(pattern)
        FSBoxFSShow [.fsBox.path.path get] $fsBox(pattern)  $fsBox(all)}
  }

  if {"$fsBoxPath" != "/"} {
    .fsBox.files.files insert end "../"
  }
  foreach fsBoxCounter $fsBoxElementList {
    if {[string match $fsBoxPattern $fsBoxCounter] ||
        [IsADir [string trimright $fsBoxPath/$fsBoxCounter "/@"]]} {
      if {"$fsBoxCounter" != "../" &&
          "$fsBoxCounter" != "./"} {
        .fsBox.files.files insert end $fsBoxCounter
      }
    }

    if {$fsBox(extensions)} {
      catch "file rootname $fsBoxCounter" fsBoxRootName
      catch "file extension $fsBoxCounter" fsBoxExtension
      set fsBoxExtension [string trimright $fsBoxExtension "/*@"]
      if {"$fsBoxExtension" != "" && "$fsBoxRootName" != ""} {
        set fsBoxInsert 1
        set fsBoxLast [.fsBox.pattern.patterns.patterns.menu index last]
        for {set fsBoxCounter1 0} {$fsBoxCounter1 <= $fsBoxLast} {incr fsBoxCounter1 1} {
          if {"*$fsBoxExtension" ==  "[lindex [.fsBox.pattern.patterns.patterns.menu entryconfigure  $fsBoxCounter1 -label] 4]"} {
            set fsBoxInsert 0
          }
        }
	if {$fsBoxInsert} {
          .fsBox.pattern.patterns.patterns.menu add command  -label "*$fsBoxExtension"  -command "
              global fsBox
              set fsBox(pattern) \"*$fsBoxExtension\"
              .fsBox.pattern.pattern delete 0 end
              .fsBox.pattern.pattern insert 0 \$fsBox(pattern)
              FSBoxFSShow \[.fsBox.path.path get\] \$fsBox(pattern)  \$fsBox(all)"
        }
      }
    }
  }
  if {$fsBox(extensions)} {
    .fsBox.pattern.patterns.patterns.menu add separator
  }
  if {$fsBox(extensions) || 
      "[.fsBox.pattern.patterns.patterns.menu index last]" == "none"} {
    .fsBox.pattern.patterns.patterns.menu add checkbutton  -label "Scan extensions"  -variable "fsBox(extensions)"  -command {
        global fsBox
        FSBoxFSShow [.fsBox.path.path get]  [.fsBox.pattern.pattern get] $fsBox(all)}
  }
}


# Procedure: HistoryTextBox
proc HistoryTextBox {} {
  global ModificationHistory
  TextBox [format "Role Playing DataBase system Modification history\n%s"  $ModificationHistory] "" 600x300 "History Box"
}


# Procedure: InputBoxInternal
proc InputBoxInternal { inputBoxMessage inputBoxCommandOk inputBoxCommandCancel inputBoxGeometry inputBoxTitle lineNum} {
# xf ignore me 6
  global inputBox

  set tmpButtonOpt ""
  set tmpFrameOpt ""
  set tmpMessageOpt ""
  set tmpScaleOpt ""
  set tmpScrollOpt ""
  if {"$inputBox(activeBackground)" != ""} {
    append tmpButtonOpt "-activebackground \"$inputBox(activeBackground)\" "
  }
  if {"$inputBox(activeForeground)" != ""} {
    append tmpButtonOpt "-activeforeground \"$inputBox(activeForeground)\" "
  }
  if {"$inputBox(background)" != ""} {
    append tmpButtonOpt "-background \"$inputBox(background)\" "
    append tmpFrameOpt "-background \"$inputBox(background)\" "
    append tmpMessageOpt "-background \"$inputBox(background)\" "
  }
  if {"$inputBox(font)" != ""} {
    append tmpButtonOpt "-font \"$inputBox(font)\" "
    append tmpMessageOpt "-font \"$inputBox(font)\" "
  }
  if {"$inputBox(foreground)" != ""} {
    append tmpButtonOpt "-foreground \"$inputBox(foreground)\" "
    append tmpMessageOpt "-foreground \"$inputBox(foreground)\" "
  }
  if {"$inputBox(scrollActiveForeground)" != ""} {
    append tmpScrollOpt "-activeforeground \"$inputBox(scrollActiveForeground)\" "
  }
  if {"$inputBox(scrollBackground)" != ""} {
    append tmpScrollOpt "-background \"$inputBox(scrollBackground)\" "
  }
  if {"$inputBox(scrollForeground)" != ""} {
    append tmpScrollOpt "-foreground \"$inputBox(scrollForeground)\" "
  }

  # start build of toplevel
  if {"[info commands XFDestroy]" != ""} {
    catch {XFDestroy $inputBox(toplevelName)}
  } {
    catch {destroy $inputBox(toplevelName)}
  }
  toplevel $inputBox(toplevelName)  -borderwidth 0
  catch "$inputBox(toplevelName) config $tmpFrameOpt"
  if {[catch "wm geometry $inputBox(toplevelName) $inputBoxGeometry"]} {
    wm geometry $inputBox(toplevelName) 350x150
  }
  wm title $inputBox(toplevelName) $inputBoxTitle
  wm maxsize $inputBox(toplevelName) 1000 1000
  wm minsize $inputBox(toplevelName) 100 100
  # end build of toplevel

  message $inputBox(toplevelName).message1  -anchor "$inputBox(anchor)"  -justify "$inputBox(justify)"  -relief raised  -text "$inputBoxMessage"
  catch "$inputBox(toplevelName).message1 config $tmpMessageOpt"

  set xfTmpWidth  [string range $inputBoxGeometry 0 [expr [string first x $inputBoxGeometry]-1]]
  if {"$xfTmpWidth" != ""} {
    # set message size
    catch "$inputBox(toplevelName).message1 configure  -width [expr $xfTmpWidth-10]"
  } {
    $inputBox(toplevelName).message1 configure  -aspect 1500
  }

  frame $inputBox(toplevelName).frame0  -borderwidth 0  -relief raised
  catch "$inputBox(toplevelName).frame0 config $tmpFrameOpt"

  frame $inputBox(toplevelName).frame1  -borderwidth 0  -relief raised
  catch "$inputBox(toplevelName).frame1 config $tmpFrameOpt"

  if {$lineNum == 1} {
    scrollbar $inputBox(toplevelName).frame1.hscroll  -orient "horizontal"  -relief raised  -command "$inputBox(toplevelName).frame1.input view"
    catch "$inputBox(toplevelName).frame1.hscroll config $tmpScrollOpt"

    entry $inputBox(toplevelName).frame1.input  -relief raised  -scrollcommand "$inputBox(toplevelName).frame1.hscroll set"
    catch "$inputBox(toplevelName).frame1.input config $tmpMessageOpt"

    $inputBox(toplevelName).frame1.input insert 0  $inputBox($inputBox(toplevelName),inputOne)
    
    # bindings
    bind $inputBox(toplevelName).frame1.input <Return> "
      global inputBox
      set inputBox($inputBox(toplevelName),inputOne) \[$inputBox(toplevelName).frame1.input get\]
      if {\"\[info commands XFDestroy\]\" != \"\"} {
        catch {XFDestroy $inputBox(toplevelName)}
      } {
        catch {destroy $inputBox(toplevelName)}
      }
      $inputBoxCommandOk"
    
    # packing
    pack append $inputBox(toplevelName).frame1  $inputBox(toplevelName).frame1.hscroll {bottom fill}  $inputBox(toplevelName).frame1.input {top fill expand}
  } {
    text $inputBox(toplevelName).frame1.input  -relief raised  -wrap none  -borderwidth 2  -yscrollcommand "$inputBox(toplevelName).frame1.vscroll set"
    catch "$inputBox(toplevelName).frame1.input config $tmpMessageOpt"

    scrollbar $inputBox(toplevelName).frame1.vscroll  -relief raised  -command "$inputBox(toplevelName).frame1.input yview"
    catch "$inputBox(toplevelName).frame1.vscroll config $tmpScrollOpt"

    $inputBox(toplevelName).frame1.input insert 1.0  $inputBox($inputBox(toplevelName),inputMulti)

    # bindings
    bind $inputBox(toplevelName).frame1.input <Control-Return> "
      global inputBox
      set inputBox($inputBox(toplevelName),inputMulti) \[$inputBox(toplevelName).frame1.input get 1.0 end\]
      if {\"\[info commands XFDestroy\]\" != \"\"} {
        catch {XFDestroy $inputBox(toplevelName)}
      } {
        catch {destroy $inputBox(toplevelName)}
      }
      $inputBoxCommandOk"
    bind $inputBox(toplevelName).frame1.input <Meta-Return> "
      global inputBox
      set inputBox($inputBox(toplevelName),inputMulti) \[$inputBox(toplevelName).frame1.input get 1.0 end\]
      if {\"\[info commands XFDestroy\]\" != \"\"} {
        catch {XFDestroy $inputBox(toplevelName)}
      } {
        catch {destroy $inputBox(toplevelName)}
      }
      $inputBoxCommandOk"

    # packing
    pack append $inputBox(toplevelName).frame1  $inputBox(toplevelName).frame1.vscroll "$inputBox(scrollSide) filly"  $inputBox(toplevelName).frame1.input {left fill expand}
  }
  
  button $inputBox(toplevelName).frame0.button0  -text "OK"  -command "
      global inputBox
      if {$lineNum == 1} {
        set inputBox($inputBox(toplevelName),inputOne) \[$inputBox(toplevelName).frame1.input get\]
      } {
        set inputBox($inputBox(toplevelName),inputMulti) \[$inputBox(toplevelName).frame1.input get 1.0 end\]
      }
      if {\"\[info commands XFDestroy\]\" != \"\"} {
        catch {XFDestroy $inputBox(toplevelName)}
      } {
        catch {destroy $inputBox(toplevelName)}
      }
      $inputBoxCommandOk"
  catch "$inputBox(toplevelName).frame0.button0 config $tmpButtonOpt"

  button $inputBox(toplevelName).frame0.button1  -text "Cancel"  -command "
      global inputBox
      if {$lineNum == 1} {
        set inputBox($inputBox(toplevelName),inputOne) \"\"
      } {
        set inputBox($inputBox(toplevelName),inputMulti) \"\"
      }
      if {\"\[info commands XFDestroy\]\" != \"\"} {
        catch {XFDestroy $inputBox(toplevelName)}
      } {
        catch {destroy $inputBox(toplevelName)}
      }
      $inputBoxCommandCancel"
  catch "$inputBox(toplevelName).frame0.button1 config $tmpButtonOpt"

  pack append $inputBox(toplevelName).frame0  $inputBox(toplevelName).frame0.button0 {left fill expand}  $inputBox(toplevelName).frame0.button1 {left fill expand}

  pack append $inputBox(toplevelName)  $inputBox(toplevelName).frame0 {bottom fill}  $inputBox(toplevelName).frame1 {bottom fill expand}  $inputBox(toplevelName).message1 {top fill}
}


# Procedure: InputBoxMulti
proc InputBoxMulti { {inputBoxMessage "Input box:"} {inputBoxCommandOk ""} {inputBoxCommandCancel ""} {inputBoxGeometry "350x150"} {inputBoxTitle "Input box"}} {
# xf ignore me 5
##########
# Procedure: InputBoxMulti
# Description: show input box with one text line
# Arguments: {inputBoxMessage} - message to display
#            {inputBoxCommandOk} - the command to call after ok
#            {inputBoxCommandCancel} - the command to call after cancel
#            {inputBoxGeometry} - the geometry for the window
#            {inputBoxTitle} - the title for the window
# Returns: The entered text
# Sideeffects: none
# Notes: there exist also a function called:
#          InputBoxOne - to enter one line text
##########
#
# global inputBox(activeBackground) - active background color
# global inputBox(activeForeground) - active foreground color
# global inputBox(anchor) - anchor for message box
# global inputBox(background) - background color
# global inputBox(erase) - erase previous text
# global inputBox(font) - message font
# global inputBox(foreground) - foreground color
# global inputBox(justify) - justify for message box
# global inputBox(scrollActiveForeground) - scrollbar active background color
# global inputBox(scrollBackground) - scrollbar background color
# global inputBox(scrollForeground) - scrollbar foreground color
# global inputBox(scrollSide) - side where scrollbar is located
# global inputBox(toplevelName) - the toplevel name
# global inputBox(toplevelName,inputMulti) - the text in the text widget

  global inputBox

  if {"$inputBoxGeometry" == ""} {
    set inputBoxGeometry 350x150
  }
  if {$inputBox(erase)} {
    set inputBox($inputBox(toplevelName),inputMulti) ""
  } {
    if {![info exists inputBox($inputBox(toplevelName),inputMulti)]} {
      set inputBox($inputBox(toplevelName),inputMulti) ""
    }
  }
  InputBoxInternal $inputBoxMessage $inputBoxCommandOk $inputBoxCommandCancel $inputBoxGeometry $inputBoxTitle 2

  # wait for the box to be destroyed
  update idletask
  grab $inputBox(toplevelName)
  tkwait window $inputBox(toplevelName)

  return $inputBox($inputBox(toplevelName),inputMulti)
}


# Procedure: InputBoxOne
proc InputBoxOne { {inputBoxMessage "Input box:"} {inputBoxCommandOk ""} {inputBoxCommandCancel ""} {inputBoxGeometry "350x150"} {inputBoxTitle "Input box"}} {
# xf ignore me 5
##########
# Procedure: InputBoxOne
# Description: show input box with one text line
# Arguments: {inputBoxMessage} - message to display
#            {inputBoxCommandOk} - the command to call after ok
#            {inputBoxCommandCancel} - the command to call after cancel
#            {inputBoxGeometry} - the geometry for the window
#            {inputBoxTitle} - the title for the window
# Returns: The entered text
# Sideeffects: none
# Notes: there exist also a function called:
#          InputBoxMulti - to enter multiline text
##########
#
# global inputBox(activeBackground) - active background color
# global inputBox(activeForeground) - active foreground color
# global inputBox(anchor) - anchor for message box
# global inputBox(background) - background color
# global inputBox(erase) - erase previous text
# global inputBox(font) - message font
# global inputBox(foreground) - foreground color
# global inputBox(justify) - justify for message box
# global inputBox(scrollActiveForeground) - scrollbar active background color
# global inputBox(scrollBackground) - scrollbar background color
# global inputBox(scrollForeground) - scrollbar foreground color
# global inputBox(scrollSide) - side where scrollbar is located
# global inputBox(toplevelName) - the toplevel name
# global inputBox(toplevelName,inputOne) - the text in the entry widget

  global inputBox

  if {$inputBox(erase)} {
    set inputBox($inputBox(toplevelName),inputOne) ""
  } {
    if {![info exists inputBox($inputBox(toplevelName),inputOne)]} {
      set inputBox($inputBox(toplevelName),inputOne) ""
    }
  }
  InputBoxInternal $inputBoxMessage $inputBoxCommandOk $inputBoxCommandCancel $inputBoxGeometry $inputBoxTitle 1

  # wait for the box to be destroyed
  update idletask
  grab $inputBox(toplevelName)
  tkwait window $inputBox(toplevelName)

  return $inputBox($inputBox(toplevelName),inputOne)
}


# Procedure: IsADir
proc IsADir { pathName} {
# xf ignore me 5
##########
# Procedure: IsADir
# Description: check if name is a directory (including symbolic links)
# Arguments: pathName - the path to check
# Returns: 1 if its a directory, otherwise 0
# Sideeffects: none
##########

  if {[file isdirectory $pathName]} {
    return 1
  } {
    catch "file type $pathName" fileType
    if {"$fileType" == "link"} {
      if {[catch "file readlink $pathName" linkName]} {
        return 0
      }
      catch "file type $linkName" fileType
      while {"$fileType" == "link"} {
        if {[catch "file readlink $linkName" linkName]} {
          return 0
        }
        catch "file type $linkName" fileType
      }
      return [file isdirectory $linkName]
    }
  }
  return 0
}


# Procedure: IsAFile
proc IsAFile { fileName} {
# xf ignore me 5
##########
# Procedure: IsAFile
# Description: check if filename is a file (including symbolic links)
# Arguments: fileName - the filename to check
# Returns: 1 if its a file, otherwise 0
# Sideeffects: none
##########

  if {[file isfile $fileName]} {
    return 1
  } {
    catch "file type $fileName" fileType
    if {"$fileType" == "link"} {
      if {[catch "file readlink $fileName" linkName]} {
        return 0
      }
      catch "file type $linkName" fileType
      while {"$fileType" == "link"} {
        if {[catch "file readlink $linkName" linkName]} {
          return 0
        }
        catch "file type $linkName" fileType
      }
      return [file isfile $linkName]
    }
  }
  return 0
}


# Procedure: IsASymlink
proc IsASymlink { fileName} {
# xf ignore me 5
##########
# Procedure: IsASymlink
# Description: check if filename is a symbolic link
# Arguments: fileName - the path/filename to check
# Returns: none
# Sideeffects: none
##########

  catch "file type $fileName" fileType
  if {"$fileType" == "link"} {
    return 1
  }
  return 0
}


# Procedure: TextBox
proc TextBox { {textBoxMessage "Text message"} {textBoxCommand ""} {textBoxGeometry "350x150"} {textBoxTitle "Text box"} args} {
# xf ignore me 5
##########
# Procedure: TextBox
# Description: show text box
# Arguments: {textBoxMessage} - the text to display
#            {textBoxCommand} - the command to call after ok
#            {textBoxGeometry} - the geometry for the window
#            {textBoxTitle} - the title for the window
#            {args} - labels of buttons
# Returns: The number of the selected button, or nothing
# Sideeffects: none
# Notes: there exist also functions called:
#          TextBoxFile - to open and read a file automatically
#          TextBoxFd - to read from an already opened filedescriptor
##########
#
# global textBox(activeBackground) - active background color
# global textBox(activeForeground) - active foreground color
# global textBox(background) - background color
# global textBox(font) - text font
# global textBox(foreground) - foreground color
# global textBox(scrollActiveForeground) - scrollbar active background color
# global textBox(scrollBackground) - scrollbar background color
# global textBox(scrollForeground) - scrollbar foreground color
# global textBox(scrollSide) - side where scrollbar is located

  global textBox

  # show text box
  if {[llength $args] > 0} {
    eval TextBoxInternal "\{$textBoxMessage\}" "\{$textBoxCommand\}" "\{$textBoxGeometry\}" "\{$textBoxTitle\}" $args
  } {
    TextBoxInternal $textBoxMessage $textBoxCommand $textBoxGeometry $textBoxTitle
  }

  if {[llength $args] > 0} {
    # wait for the box to be destroyed
    update idletask
    grab $textBox(toplevelName)
    tkwait window $textBox(toplevelName)

    return $textBox(button)
  }
}


# Procedure: TextBoxFd
proc TextBoxFd { {textBoxInFile ""} {textBoxCommand ""} {textBoxGeometry "350x150"} {textBoxTitle "Text box"} args} {
# xf ignore me 5
##########
# Procedure: TextBoxFd
# Description: show text box containing a filedescriptor
# Arguments: {textBoxInFile} - a filedescriptor to read. The descriptor
#                              is closed after reading
#            {textBoxCommand} - the command to call after ok
#            {textBoxGeometry} - the geometry for the window
#            {textBoxTitle} - the title for the window
#            {args} - labels of buttons
# Returns: The number of the selected button, ot nothing
# Sideeffects: none
# Notes: there exist also functions called:
#          TextBox - to display a passed string
#          TextBoxFile - to open and read a file automatically
##########
#
# global textBox(activeBackground) - active background color
# global textBox(activeForeground) - active foreground color
# global textBox(background) - background color
# global textBox(font) - text font
# global textBox(foreground) - foreground color
# global textBox(scrollActiveForeground) - scrollbar active background color
# global textBox(scrollBackground) - scrollbar background color
# global textBox(scrollForeground) - scrollbar foreground color
# global textBox(scrollSide) - side where scrollbar is located

  global textBox

  # check file existance
  if {"$textBoxInFile" == ""} {
    puts stderr "No filedescriptor specified"
    return
  }

  set textBoxMessage [read $textBoxInFile]
  close $textBoxInFile

  # show text box
  if {[llength $args] > 0} {
    eval TextBoxInternal "\{$textBoxMessage\}" "\{$textBoxCommand\}" "\{$textBoxGeometry\}" "\{$textBoxTitle\}" $args
  } {
    TextBoxInternal $textBoxMessage $textBoxCommand $textBoxGeometry $textBoxTitle
  }

  if {[llength $args] > 0} {
    # wait for the box to be destroyed
    update idletask
    grab $textBox(toplevelName)
    tkwait window $textBox(toplevelName)

    return $textBox(button)
  }
}


# Procedure: TextBoxFile
proc TextBoxFile { {textBoxFile ""} {textBoxCommand ""} {textBoxGeometry "350x150"} {textBoxTitle "Text box"} args} {
# xf ignore me 5
##########
# Procedure: TextBoxFile
# Description: show text box containing a file
# Arguments: {textBoxFile} - filename to read
#            {textBoxCommand} - the command to call after ok
#            {textBoxGeometry} - the geometry for the window
#            {textBoxTitle} - the title for the window
#            {args} - labels of buttons
# Returns: The number of the selected button, ot nothing
# Sideeffects: none
# Notes: there exist also functions called:
#          TextBox - to display a passed string
#          TextBoxFd - to read from an already opened filedescriptor
##########
#
# global textBox(activeBackground) - active background color
# global textBox(activeForeground) - active foreground color
# global textBox(background) - background color
# global textBox(font) - text font
# global textBox(foreground) - foreground color
# global textBox(scrollActiveForeground) - scrollbar active background color
# global textBox(scrollBackground) - scrollbar background color
# global textBox(scrollForeground) - scrollbar foreground color
# global textBox(scrollSide) - side where scrollbar is located

  global textBox

  # check file existance
  if {"$textBoxFile" == ""} {
    puts stderr "No filename specified"
    return
  }

  if {[catch "open $textBoxFile r" textBoxInFile]} {
    puts stderr "$textBoxInFile"
    return
  }

  set textBoxMessage [read $textBoxInFile]
  close $textBoxInFile

  # show text box
  if {[llength $args] > 0} {
    eval TextBoxInternal "\{$textBoxMessage\}" "\{$textBoxCommand\}" "\{$textBoxGeometry\}" "\{$textBoxTitle\}" $args
  } {
    TextBoxInternal $textBoxMessage $textBoxCommand $textBoxGeometry $textBoxTitle
  }

  if {[llength $args] > 0} {
    # wait for the box to be destroyed
    update idletask
    grab $textBox(toplevelName)
    tkwait window $textBox(toplevelName)

    return $textBox(button)
  }
}


# Procedure: TextBoxInternal
proc TextBoxInternal { textBoxMessage textBoxCommand textBoxGeometry textBoxTitle args} {
# xf ignore me 6
  global textBox

  set tmpButtonOpt ""
  set tmpFrameOpt ""
  set tmpMessageOpt ""
  set tmpScrollOpt ""
  if {"$textBox(activeBackground)" != ""} {
    append tmpButtonOpt "-activebackground \"$textBox(activeBackground)\" "
  }
  if {"$textBox(activeForeground)" != ""} {
    append tmpButtonOpt "-activeforeground \"$textBox(activeForeground)\" "
  }
  if {"$textBox(background)" != ""} {
    append tmpButtonOpt "-background \"$textBox(background)\" "
    append tmpFrameOpt "-background \"$textBox(background)\" "
    append tmpMessageOpt "-background \"$textBox(background)\" "
  }
  if {"$textBox(font)" != ""} {
    append tmpButtonOpt "-font \"$textBox(font)\" "
    append tmpMessageOpt "-font \"$textBox(font)\" "
  }
  if {"$textBox(foreground)" != ""} {
    append tmpButtonOpt "-foreground \"$textBox(foreground)\" "
    append tmpMessageOpt "-foreground \"$textBox(foreground)\" "
  }
  if {"$textBox(scrollActiveForeground)" != ""} {
    append tmpScrollOpt "-activeforeground \"$textBox(scrollActiveForeground)\" "
  }
  if {"$textBox(scrollBackground)" != ""} {
    append tmpScrollOpt "-background \"$textBox(scrollBackground)\" "
  }
  if {"$textBox(scrollForeground)" != ""} {
    append tmpScrollOpt "-foreground \"$textBox(scrollForeground)\" "
  }

  # start build of toplevel
  if {"[info commands XFDestroy]" != ""} {
    catch {XFDestroy $textBox(toplevelName)}
  } {
    catch {destroy $textBox(toplevelName)}
  }
  toplevel $textBox(toplevelName)  -borderwidth 0
  catch "$textBox(toplevelName) config $tmpFrameOpt"
  if {[catch "wm geometry $textBox(toplevelName) $textBoxGeometry"]} {
    wm geometry $textBox(toplevelName) 350x150
  }
  wm title $textBox(toplevelName) $textBoxTitle
  wm maxsize $textBox(toplevelName) 1000 1000
  wm minsize $textBox(toplevelName) 100 100
  # end build of toplevel

  frame $textBox(toplevelName).frame0  -borderwidth 0  -relief raised
  catch "$textBox(toplevelName).frame0 config $tmpFrameOpt"

  text $textBox(toplevelName).frame0.text1  -relief raised  -wrap none  -borderwidth 2  -yscrollcommand "$textBox(toplevelName).frame0.vscroll set"
  catch "$textBox(toplevelName).frame0.text1 config $tmpMessageOpt"

  scrollbar $textBox(toplevelName).frame0.vscroll  -relief raised  -command "$textBox(toplevelName).frame0.text1 yview"
  catch "$textBox(toplevelName).frame0.vscroll config $tmpScrollOpt"

  frame $textBox(toplevelName).frame1  -borderwidth 0  -relief raised
  catch "$textBox(toplevelName).frame1 config $tmpFrameOpt"

  set textBoxCounter 0
  set buttonNum [llength $args]

  if {$buttonNum > 0} {
    while {$textBoxCounter < $buttonNum} {
      button $textBox(toplevelName).frame1.button$textBoxCounter  -text "[lindex $args $textBoxCounter]"  -command "
          global textBox
          set textBox(button) $textBoxCounter
          set textBox(contents) \[$textBox(toplevelName).frame0.text1 get 1.0 end\]
          if {\"\[info commands XFDestroy\]\" != \"\"} {
            catch {XFDestroy $textBox(toplevelName)}
          } {
            catch {destroy $textBox(toplevelName)}
          }"
      catch "$textBox(toplevelName).frame1.button$textBoxCounter config $tmpButtonOpt"

      pack append $textBox(toplevelName).frame1  $textBox(toplevelName).frame1.button$textBoxCounter {left fillx expand}

      incr textBoxCounter
    }
  } {
    button $textBox(toplevelName).frame1.button0  -text "OK"  -command "
        global textBox
        set textBox(button) 0
        set textBox(contents) \[$textBox(toplevelName).frame0.text1 get 1.0 end\]
        if {\"\[info commands XFDestroy\]\" != \"\"} {
          catch {XFDestroy $textBox(toplevelName)}
        } {
          catch {destroy $textBox(toplevelName)}
        }
        $textBoxCommand"
    catch "$textBox(toplevelName).frame1.button0 config $tmpButtonOpt"

    pack append $textBox(toplevelName).frame1  $textBox(toplevelName).frame1.button0 {left fillx expand}
  }

  $textBox(toplevelName).frame0.text1 insert end "$textBoxMessage"

  $textBox(toplevelName).frame0.text1 config  -state $textBox(state)

  # packing
  pack append $textBox(toplevelName).frame0  $textBox(toplevelName).frame0.vscroll "$textBox(scrollSide) filly"  $textBox(toplevelName).frame0.text1 {left fill expand}
  pack append $textBox(toplevelName)  $textBox(toplevelName).frame1 {bottom fill}  $textBox(toplevelName).frame0 {top fill expand}
}


# Procedure: VersionAlertBox
proc VersionAlertBox {} {
  global Ident
  AlertBox [format "Role Playing DataBase system V1.0\n\n%s" $Ident] "" 400x80
}


# Procedure: YesNoBox
proc YesNoBox { {yesNoBoxMessage "Yes/no message"} {yesNoBoxGeometry "350x150"}} {
# xf ignore me 5
##########
# Procedure: YesNoBox
# Description: show yesno box
# Arguments: {yesNoBoxMessage} - the text to display
#            {yesNoBoxGeometry} - the geometry for the window
# Returns: none
# Sideeffects: none
##########
#
# global yesNoBox(activeBackground) - active background color
# global yesNoBox(activeForeground) - active foreground color
# global yesNoBox(anchor) - anchor for message box
# global yesNoBox(background) - background color
# global yesNoBox(font) - message font
# global yesNoBox(foreground) - foreground color
# global yesNoBox(justify) - justify for message box
# global yesNoBox(afterNo) - destroy yes-no box after n seconds.
#                            The no button is activated
# global yesNoBox(afterYes) - destroy yes-no box after n seconds.
#                             The yes button is activated

  global yesNoBox

  set tmpButtonOpt ""
  set tmpFrameOpt ""
  set tmpMessageOpt ""
  if {"$yesNoBox(activeBackground)" != ""} {
    append tmpButtonOpt "-activebackground \"$yesNoBox(activeBackground)\" "
  }
  if {"$yesNoBox(activeForeground)" != ""} {
    append tmpButtonOpt "-activeforeground \"$yesNoBox(activeForeground)\" "
  }
  if {"$yesNoBox(background)" != ""} {
    append tmpButtonOpt "-background \"$yesNoBox(background)\" "
    append tmpFrameOpt "-background \"$yesNoBox(background)\" "
    append tmpMessageOpt "-background \"$yesNoBox(background)\" "
  }
  if {"$yesNoBox(font)" != ""} {
    append tmpButtonOpt "-font \"$yesNoBox(font)\" "
    append tmpMessageOpt "-font \"$yesNoBox(font)\" "
  }
  if {"$yesNoBox(foreground)" != ""} {
    append tmpButtonOpt "-foreground \"$yesNoBox(foreground)\" "
    append tmpMessageOpt "-foreground \"$yesNoBox(foreground)\" "
  }

  # start build of toplevel
  if {"[info commands XFDestroy]" != ""} {
    catch {XFDestroy .yesNoBox}
  } {
    catch {destroy .yesNoBox}
  }
  toplevel .yesNoBox  -borderwidth 0
  catch ".yesNoBox config $tmpFrameOpt"
  if {[catch "wm geometry .yesNoBox $yesNoBoxGeometry"]} {
    wm geometry .yesNoBox 350x150
  }
  wm title .yesNoBox {Alert box}
  wm maxsize .yesNoBox 1000 1000
  wm minsize .yesNoBox 100 100
  # end build of toplevel

  message .yesNoBox.message1  -anchor "$yesNoBox(anchor)"  -justify "$yesNoBox(justify)"  -relief raised  -text "$yesNoBoxMessage"
  catch ".yesNoBox.message1 config $tmpMessageOpt"

  set xfTmpWidth  [string range $yesNoBoxGeometry 0 [expr [string first x $yesNoBoxGeometry]-1]]
  if {"$xfTmpWidth" != ""} {
    # set message size
    catch ".yesNoBox.message1 configure  -width [expr $xfTmpWidth-10]"
  } {
    .yesNoBox.message1 configure  -aspect 1500
  }

  frame .yesNoBox.frame1  -borderwidth 0  -relief raised
  catch ".yesNoBox.frame1 config $tmpFrameOpt"

  button .yesNoBox.frame1.button0  -text "Yes"  -command "
      global yesNoBox
      set yesNoBox(button) 1
      if {\"\[info commands XFDestroy\]\" != \"\"} {
        catch {XFDestroy .yesNoBox}
      } {
        catch {destroy .yesNoBox}
      }"
  catch ".yesNoBox.frame1.button0 config $tmpButtonOpt"

  button .yesNoBox.frame1.button1  -text "No"  -command "
      global yesNoBox
      set yesNoBox(button) 0
      if {\"\[info commands XFDestroy\]\" != \"\"} {
        catch {XFDestroy .yesNoBox}
      } {
        catch {destroy .yesNoBox}
      }"
  catch ".yesNoBox.frame1.button1 config $tmpButtonOpt"

  pack append .yesNoBox.frame1  .yesNoBox.frame1.button0 {left fillx expand}  .yesNoBox.frame1.button1 {left fillx expand}

  # packing
  pack append .yesNoBox  .yesNoBox.frame1 {bottom fill}  .yesNoBox.message1 {top fill expand}

  if {$yesNoBox(afterYes) != 0} {
    after [expr $yesNoBox(afterYes)*1000]  "catch \".yesNoBox.frame1.button0 invoke\""
  }
  if {$yesNoBox(afterNo) != 0} {
    after [expr $yesNoBox(afterNo)*1000]  "catch \".yesNoBox.frame1.button1 invoke\""
  }

  # wait for the box to be destroyed
  update idletask
  grab .yesNoBox
  tkwait window .yesNoBox

  return $yesNoBox(button)
}


# Internal procedures


# Procedure: Alias
proc Alias { args} {
# xf ignore me 7
##########
# Procedure: Alias
# Description: establish an alias for a procedure
# Arguments: args - no argument means that a list of all aliases
#                   is returned. Otherwise the first parameter is
#                   the alias name, and the second parameter is
#                   the procedure that is aliased.
# Returns: nothing, the command that is bound to the alias or a
#          list of all aliases - command pairs. 
# Sideeffects: internalAliasList is updated, and the alias
#              proc is inserted
##########
  global internalAliasList

  if {[llength $args] == 0} {
    return $internalAliasList
  } {
    if {[llength $args] == 1} {
      set xfTmpIndex [lsearch $internalAliasList "[lindex $args 0] *"]
      if {$xfTmpIndex != -1} {
        return [lindex [lindex $internalAliasList $xfTmpIndex] 1]
      }
    } {
      if {[llength $args] == 2} {
        eval "proc [lindex $args 0] {args} {#xf ignore me 4
return \[eval \"[lindex $args 1] \$args\"\]}"
        set xfTmpIndex [lsearch $internalAliasList "[lindex $args 0] *"]
        if {$xfTmpIndex != -1} {
          set internalAliasList [lreplace $internalAliasList $xfTmpIndex $xfTmpIndex "[lindex $args 0] [lindex $args 1]"]
        } {
          lappend internalAliasList "[lindex $args 0] [lindex $args 1]"
        }
      } {
        error "Alias: wrong number or args: $args"
      }
    }
  }
}


# Procedure: GetSelection
if {"[info procs GetSelection]" == ""} {
proc GetSelection {} {
# xf ignore me 7
##########
# Procedure: GetSelection
# Description: get current selection
# Arguments: none
# Returns: none
# Sideeffects: none
##########

  # the save way
  set xfSelection ""
  catch "selection get" xfSelection
  if {"$xfSelection" == "selection doesn't exist or form \"STRING\" not defined"} {
    return ""
  } {
    return $xfSelection
  }
}
}


# Procedure: Unalias
proc Unalias { aliasName} {
# xf ignore me 7
##########
# Procedure: Unalias
# Description: remove an alias for a procedure
# Arguments: aliasName - the alias name to remove
# Returns: none
# Sideeffects: internalAliasList is updated, and the alias
#              proc is removed
##########
  global internalAliasList

  set xfIndex [lsearch $internalAliasList "$aliasName *"]
  if {$xfIndex != -1} {
    rename $aliasName ""
    set internalAliasList [lreplace $internalAliasList $xfIndex $xfIndex]
  }
}

# XFNoParsing
# Program: template
# Description: select colors
#
# The HSV <-> RGB converting routines are from the
# tcolor demo that is part of the demo site of Tk.
#
# $Header: /home/heller/Deepwoods/RolePlaying/RCS/SYSFunctions,v 1.3 1995/07/03 18:24:02 heller Exp $

proc ColorBox {{colorBoxFileColor "/usr/local/lib/xf/lib/Colors"} {colorBoxMessage "Color"} {colorBoxEntryW ""} {colorBoxTargetW ""}} {# xf ignore me 5
##########
# Procedure: ColorBox
# Description: select a color
# Arguments: {colorBoxFileColor} - the color file with all colornames
#            {colorBoxMessage} - a message to display
#            {colorBoxEntryW} - the widget name for the resulting color name
#            {colorBoxTargetW} - the widget we configure
# Returns: colorname, or nothing
# Sideeffects: none
##########
# 
# global colorBox(activeBackground) - active background color
# global colorBox(activeForeground) - active foreground color
# global colorBox(background) - background color
# global colorBox(font) - text font
# global colorBox(foreground) - foreground color
# global colorBox(palette) - a palette of colors
# global colorBox(scrollActiveForeground) - scrollbar active background color
# global colorBox(scrollBackground) - scrollbar background color
# global colorBox(scrollForeground) - scrollbar foreground color
# global colorBox(scrollSide) - side where scrollbar is located

  global colorBox

  set colorBox(colorName) ""
  set colorBox(paletteNr) 0

  set tmpButtonOpt ""
  set tmpFrameOpt ""
  set tmpMessageOpt ""
  set tmpScaleOpt ""
  set tmpScrollOpt ""
  if {"$colorBox(activeBackground)" != ""} {
    append tmpButtonOpt "-activebackground \"$colorBox(activeBackground)\" "
  }
  if {"$colorBox(activeForeground)" != ""} {
    append tmpButtonOpt "-activeforeground \"$colorBox(activeForeground)\" "
  }
  if {"$colorBox(background)" != ""} {
    append tmpButtonOpt "-background \"$colorBox(background)\" "
    append tmpFrameOpt "-background \"$colorBox(background)\" "
    append tmpMessageOpt "-background \"$colorBox(background)\" "
    append tmpScaleOpt "-background \"$colorBox(background)\" "
  }
  if {"$colorBox(font)" != ""} {
    append tmpButtonOpt "-font \"$colorBox(font)\" "
    append tmpMessageOpt "-font \"$colorBox(font)\" "
  }
  if {"$colorBox(foreground)" != ""} {
    append tmpButtonOpt "-foreground \"$colorBox(foreground)\" "
    append tmpMessageOpt "-foreground \"$colorBox(foreground)\" "
    append tmpScaleOpt "-foreground \"$colorBox(foreground)\" "
  }
  if {"$colorBox(scrollActiveForeground)" != ""} {
    append tmpScaleOpt "-activeforeground \"$colorBox(scrollActiveForeground)\" "
    append tmpScrollOpt "-activeforeground \"$colorBox(scrollActiveForeground)\" "
  }
  if {"$colorBox(scrollBackground)" != ""} {
    append tmpScrollOpt "-background \"$colorBox(scrollBackground)\" "
  }
  if {"$colorBox(scrollForeground)" != ""} {
    append tmpScrollOpt "-foreground \"$colorBox(scrollForeground)\" "
  }

  # get color file name
  if {!([file exists $colorBoxFileColor] &&
        [file readable $colorBoxFileColor])} {
    set colorBoxFileColor ""
  }
  if {"$colorBoxFileColor" == ""} {
    global env
    if {[info exists env(XF_COLOR_FILE)]} {
      if {[file exists $env(XF_COLOR_FILE)] &&
          [file readable $env(XF_COLOR_FILE)]} {
        set colorBoxFileColor $env(XF_COLOR_FILE)
      }
    }
  }
  if {"$colorBoxMessage" == ""} {
    set colorBoxMessage "Color"
  }

  # save the the current widget color
  if {"$colorBoxTargetW" != ""} {
    if {[catch "$colorBoxTargetW config -[string tolower $colorBoxMessage]" result]} {
      set colorBoxSavedColor ""
    } {
      set colorBoxSavedColor [lindex $result 4]
    }
  } {
    set colorBoxSavedColor ""
  }

  # look if there is already a color window
  if {"[info commands .colorBox]" == ""} {
    # build widget structure

    # start build of toplevel
    if {"[info commands XFDestroy]" != ""} {
      catch {XFDestroy .colorBox}
    } {
      catch {destroy .colorBox}
    }
    toplevel .colorBox \
      -borderwidth 0
    catch ".colorBox config $tmpFrameOpt"
    wm geometry .colorBox 400x250
    wm title .colorBox {Color box}
    wm maxsize .colorBox 1000 1000
    wm minsize .colorBox 100 100
    # end build of toplevel

    set colorBox(oldWidget) $colorBoxEntryW

    frame .colorBox.frame1 \
      -borderwidth 0 \
      -relief raised
    catch ".colorBox.frame1 config $tmpFrameOpt"
 
    button .colorBox.frame1.ok \
      -text "OK"
    catch ".colorBox.frame1.ok config $tmpButtonOpt"

    button .colorBox.frame1.cancel \
      -text "Cancel"
    catch ".colorBox.frame1.cancel config $tmpButtonOpt"

    frame .colorBox.frame2 \
      -borderwidth 0 \
      -relief raised
    catch ".colorBox.frame2 config $tmpFrameOpt"
 
    radiobutton .colorBox.frame2.rgb \
      -command "ColorBoxShowSlides $colorBoxMessage \"$colorBoxTargetW\"" \
      -text "RGB" \
      -variable colorBox(type)
    catch ".colorBox.frame2.rgb config $tmpButtonOpt"

    radiobutton .colorBox.frame2.hsv \
      -command "ColorBoxShowSlides $colorBoxMessage \"$colorBoxTargetW\"" \
      -text "HSV" \
      -variable colorBox(type)
    catch ".colorBox.frame2.hsv config $tmpButtonOpt"

    radiobutton .colorBox.frame2.list \
      -command "ColorBoxShowSlides $colorBoxMessage \"$colorBoxTargetW\"" \
      -text "List" \
      -variable colorBox(type)
    catch ".colorBox.frame2.list config $tmpButtonOpt"

    frame .colorBox.palette \
      -borderwidth 0 \
      -relief raised
    catch ".colorBox.palette config $tmpFrameOpt"
 
    set counter 0
    foreach element $colorBox(palette) {
      button .colorBox.palette.palette$counter \
        -command "ColorBoxSetPalette $colorBoxMessage \"$colorBoxTargetW\" $counter" \
               -width 3
      catch ".colorBox.palette.palette$counter config \
        -activebackground \"$element\" \
        -background \"$element\""

      pack append .colorBox.palette .colorBox.palette.palette$counter {left fill expand}
      incr counter
    }

    scale .colorBox.red \
      -background "red" \
      -from 0 \
      -label "Red" \
      -orient horizontal \
      -relief raised \
      -sliderlength 15 \
      -to 255 \
      -width 8
    catch ".colorBox.red config $tmpScaleOpt"

    scale .colorBox.green \
      -background "green" \
      -from 0 \
      -label "Green" \
      -orient horizontal \
      -relief raised \
      -sliderlength 15 \
      -to 255 \
      -width 8
    catch ".colorBox.green config $tmpScaleOpt"

    scale .colorBox.blue \
      -background "blue" \
      -from 0 \
      -label "Blue" \
      -orient horizontal \
      -relief raised \
      -sliderlength 15 \
      -to 255 \
      -width 8
    catch ".colorBox.blue config $tmpScaleOpt"

    scale .colorBox.h \
      -from 0 \
      -label "Hue" \
      -orient horizontal \
      -relief raised \
      -sliderlength 15 \
      -to 1000 \
      -width 8
    catch ".colorBox.h config $tmpScaleOpt"

   scale .colorBox.s \
     -from 0 \
     -label "Saturation * 100" \
     -orient horizontal \
     -relief raised \
     -sliderlength 15 \
     -to 1000 \
     -width 8
    catch ".colorBox.s config $tmpScaleOpt"

    scale .colorBox.v \
      -from 0 \
      -label "Value" \
      -orient horizontal \
      -relief raised \
      -sliderlength 15 \
      -to 1000 \
      -width 8
    catch ".colorBox.v config $tmpScaleOpt"

    label .colorBox.demo \
      -relief raised \
      -text "This text shows the results :-)"
    catch ".colorBox.demo config $tmpMessageOpt"

    frame .colorBox.current \
      -borderwidth 0 \
      -relief raised
    catch ".colorBox.current config $tmpFrameOpt"

    label .colorBox.current.labelcurrent \
      -relief raised
    catch ".colorBox.current.labelcurrent config $tmpMessageOpt"

    entry .colorBox.current.current \
      -relief raised
    catch ".colorBox.current.current config $tmpMessageOpt"

    frame .colorBox.colors \
      -borderwidth 0 \
      -relief raised
    catch ".colorBox.colors config $tmpFrameOpt"

    scrollbar .colorBox.colors.vscroll \
      -relief raised \
      -command ".colorBox.colors.colors yview"
    catch ".colorBox.colors.vscroll config $tmpScrollOpt"

    scrollbar .colorBox.colors.hscroll \
      -orient horiz \
      -relief raised \
      -command ".colorBox.colors.colors xview"
    catch ".colorBox.colors.hscroll config $tmpScrollOpt"

    listbox .colorBox.colors.colors \
      -exportselection false \
      -relief raised \
      -xscrollcommand ".colorBox.colors.hscroll set" \
      -yscrollcommand ".colorBox.colors.vscroll set"
    catch ".colorBox.colors.colors config $tmpMessageOpt"

    # read color file
    if {"$colorBoxFileColor" != ""} {
      if {[catch "open $colorBoxFileColor r" colorInFile]} {
        set colorBoxFileColor ""
        if {"[info commands AlertBox]" != ""} {
          AlertBox "$colorInFile"
        } {
          puts stderr "$colorInFile"
        }
      } {
        set colorReadList [read $colorInFile]
        close $colorInFile
        foreach colorLine [split $colorReadList "\n"] {
          if {"[string trim $colorLine]" != ""} {
            set colorNewLine [lrange $colorLine 3 end]
            append colorNewLine " " [format #%02x [lindex $colorLine 0]]
            append colorNewLine [format %02x [lindex $colorLine 1]]
            append colorNewLine [format %02x [lindex $colorLine 2]]
            .colorBox.colors.colors insert end $colorNewLine
          }
        }
      }
    }

    # bindings
    bind .colorBox.colors.colors <ButtonPress-1> "
      ColorBoxSelectColor %W $colorBoxMessage \"$colorBoxTargetW\" %y"
    bind .colorBox.colors.colors <Button1-Motion> "
      ColorBoxSelectColor %W $colorBoxMessage \"$colorBoxTargetW\" %y"
    bind .colorBox.colors.colors <Shift-ButtonPress-1> "
      ColorBoxSelectColor %W $colorBoxMessage \"$colorBoxTargetW\" %y"
    bind .colorBox.colors.colors <Shift-Button1-Motion> "
      ColorBoxSelectColor %W $colorBoxMessage \"$colorBoxTargetW\" %y"
  } {
    if {"[winfo class $colorBox(oldWidget)]" == "Text"} {
      catch "$colorBox(oldWidget) delete 1.0 end"
      catch "$colorBox(oldWidget) insert 1.0 [.colorBox.current.current get]"
    } {
      if {"[winfo class $colorBox(oldWidget)]" == "Entry"} {
        catch "$colorBox(oldWidget) delete 0 end"
        catch "$colorBox(oldWidget) insert 0 [.colorBox.current.current get]"
      }
    }

    set colorBox(oldWidget) $colorBoxEntryW
  }
   
  .colorBox.frame1.ok config \
    -command "
      global colorBox
      set colorBox(colorName) \[.colorBox.current.current get\]
      if {\"$colorBoxEntryW\" != \"\"} {
        if {\"\[winfo class $colorBoxEntryW\]\" == \"Text\"} {
          catch \"$colorBoxEntryW delete 1.0 end\"
          catch \"$colorBoxEntryW insert 1.0 \\\"\$colorBox(colorName)\\\"\"
        } {
          if {\"\[winfo class $colorBoxEntryW\]\" == \"Entry\"} {
            catch \"$colorBoxEntryW delete 0 end\"
            catch \"$colorBoxEntryW insert 0 \\\"\$colorBox(colorName)\\\"\"
          }
        }
      }
      if {\"\[info commands XFDestroy\]\" != \"\"} {
        catch {XFDestroy .colorBox}
      } {
        catch {destroy .colorBox}
      }"

  .colorBox.frame1.cancel config \
    -command "
      global colorBox
      set colorBox(colorName) {}
      if {\"$colorBoxTargetW\" != \"\"} {
        catch \"$colorBoxTargetW config -\[string tolower $colorBoxMessage\] $colorBoxSavedColor\"
      }
      if {\"\[info commands XFDestroy\]\" != \"\"} {
        catch {XFDestroy .colorBox}
      } {
        catch {destroy .colorBox}
      }"

  .colorBox.red config \
    -command "ColorBoxSetRGBColor $colorBoxMessage \"$colorBoxTargetW\""

  .colorBox.green config \
    -command "ColorBoxSetRGBColor $colorBoxMessage \"$colorBoxTargetW\""

  .colorBox.blue config \
    -command "ColorBoxSetRGBColor $colorBoxMessage \"$colorBoxTargetW\""

  .colorBox.h config \
    -command "ColorBoxSetHSVColor $colorBoxMessage \"$colorBoxTargetW\""

  .colorBox.s config \
    -command "ColorBoxSetHSVColor $colorBoxMessage \"$colorBoxTargetW\""

  .colorBox.v config \
    -command "ColorBoxSetHSVColor $colorBoxMessage \"$colorBoxTargetW\""

  .colorBox.current.labelcurrent config \
    -text "$colorBoxMessage:"

  # bindings
  bind .colorBox.current.current <Return> "
    ColorBoxSetPaletteList \[.colorBox.current.current get\]
    ColorBoxSetColor $colorBoxMessage \"$colorBoxTargetW\" text \[.colorBox.current.current get\]"

  bind .colorBox.colors.colors <Double-1> "
    ColorBoxSelectColor %W $colorBoxMessage \"$colorBoxTargetW\" %y
    global colorBox
    set colorBox(colorName) \[.colorBox.current.current get\]
    if {\"$colorBoxEntryW\" != \"\"} {
      if {\"\[winfo class $colorBoxEntryW\]\" == \"Text\"} {
        catch \"$colorBoxEntryW delete 1.0 end\"
        catch \"$colorBoxEntryW insert 1.0 \\\"\$colorBox(colorName)\\\"\"
      } {
        if {\"\[winfo class $colorBoxEntryW\]\" == \"Entry\"} {
          catch \"$colorBoxEntryW delete 0 end\"
          catch \"$colorBoxEntryW insert 0 \\\"\$colorBox(colorName)\\\"\"
        }
      }
    }
    if {\"\[info commands XFDestroy\]\" != \"\"} {
      catch {XFDestroy .colorBox}
    } {
      catch {destroy .colorBox}
    }"

  # set up current value
  .colorBox.current.current delete 0 end
  if {"$colorBoxEntryW" != ""} {
    if {"[winfo class $colorBoxEntryW]" == "Text"} {
      .colorBox.current.current insert 0 [$colorBoxEntryW get 1.0 end]
    } {
      if {"[winfo class $colorBoxEntryW]" == "Entry"} {
        .colorBox.current.current insert 0 [$colorBoxEntryW get]
      }
    }
  }
  if {"[.colorBox.current.current get]" != ""} {
    ColorBoxSetColor $colorBoxMessage $colorBoxTargetW text [.colorBox.current.current get]
  }
    
  # packing
  pack append .colorBox.frame1 \
              .colorBox.frame1.ok {left fill expand} \
              .colorBox.frame1.cancel {left fill expand}
  pack append .colorBox.frame2 \
              .colorBox.frame2.rgb {left fill expand} \
              .colorBox.frame2.hsv {left fill expand} \
              .colorBox.frame2.list {left fill expand}
  pack append .colorBox.current \
              .colorBox.current.labelcurrent {left} \
              .colorBox.current.current {left fill expand}
  pack append .colorBox.colors \
              .colorBox.colors.vscroll "$colorBox(scrollSide) filly" \
              .colorBox.colors.hscroll {bottom fillx} \
              .colorBox.colors.colors {left fill expand}

  ColorBoxShowSlides $colorBoxMessage $colorBoxTargetW

  catch "wm deiconify .colorBox"

  if {"$colorBoxEntryW" == ""} {
    # wait for the box to be destroyed
    update idletask
    grab .colorBox
    tkwait window .colorBox

    return $colorBox(colorName)
  }
}

##########
# Procedure: ColorBoxSelectColor
# Description: select color for color composing
# Arguments: colorW - the widget
#            colorBoxMessage - the message for the color
#            colorBoxTargetW - the widget we configure
#            colorY - the y position in the listbox
# Returns: none
# Sideeffects: none
##########
proc ColorBoxSelectColor {colorW colorBoxMessage colorBoxTargetW colorY} {# xf ignore me 6

  set colorNearest [$colorW nearest $colorY]
  if {$colorNearest >= 0} {
    $colorW select from $colorNearest
    $colorW select to $colorNearest
    set colorTmpValue [$colorW get $colorNearest]
    set colorCurrentColor [lrange $colorTmpValue 0 \
          [expr [llength $colorTmpValue]-2]]
    set colorCurrentValue [lrange $colorTmpValue \
          [expr [llength $colorTmpValue]-1] end]

    scan [string range $colorCurrentValue 1 2] "%x" colorBoxValue
    .colorBox.red set $colorBoxValue
    scan [string range $colorCurrentValue 3 4] "%x" colorBoxValue
    .colorBox.green set $colorBoxValue
    scan [string range $colorCurrentValue 5 6] "%x" colorBoxValue
    .colorBox.blue set $colorBoxValue

    .colorBox.current.current delete 0 end
    .colorBox.current.current insert 0 $colorCurrentColor
    ColorBoxSetColor $colorBoxMessage $colorBoxTargetW list $colorCurrentColor
    ColorBoxSetPaletteList $colorCurrentColor
  }
}

##########
# Procedure: ColorBoxSetColor
# Description: set the new color
# Arguments: colorBoxMessage - the message for the color
#            colorBoxTargetW - the widget we configure
#            colorBoxType - who wants to set the demo area
#            colorBoxValue - the value to set
# Returns: none
# Sideeffects: none
##########
proc ColorBoxSetColor {colorBoxMessage colorBoxTargetW colorBoxType colorBoxValue} {# xf ignore me 6
  global colorBox

  .colorBox.red config \
    -command "NoFunction"
  .colorBox.green config \
    -command "NoFunction"
  .colorBox.blue config \
    -command "NoFunction"
  .colorBox.h config \
    -command "NoFunction"
  .colorBox.s config \
    -command "NoFunction"
  .colorBox.v config \
    -command "NoFunction"

  set colorBoxSetColor ""
  if {"$colorBoxValue" != ""} {
    if {"$colorBoxType" != "text"} {
      .colorBox.current.current delete 0 end
      .colorBox.current.current insert 0 $colorBoxValue
    }
    if {[string match "*oreground*" $colorBoxMessage]} {
      catch ".colorBox.demo config -foreground $colorBoxValue"
    } {
      catch ".colorBox.demo config -background $colorBoxValue"
    }
    if {"$colorBoxTargetW" != ""} {
      catch "$colorBoxTargetW config -[string tolower $colorBoxMessage] \
        $colorBoxValue"
    }
  }
  case $colorBoxType in {
    {text palette} {
      if {[string match "*oreground*" $colorBoxMessage]} {
        set red [expr [lindex [winfo rgb .colorBox.demo [lindex [.colorBox.demo config -foreground] 4]] 0]/256]
        set green [expr [lindex [winfo rgb .colorBox.demo [lindex [.colorBox.demo config -foreground] 4]] 1]/256]
        set blue [expr [lindex [winfo rgb .colorBox.demo [lindex [.colorBox.demo config -foreground] 4]] 2]/256]
      } {
        set red [expr [lindex [winfo rgb .colorBox.demo [lindex [.colorBox.demo config -background] 4]] 0]/256]
        set green [expr [lindex [winfo rgb .colorBox.demo [lindex [.colorBox.demo config -background] 4]] 1]/256]
        set blue [expr [lindex [winfo rgb .colorBox.demo [lindex [.colorBox.demo config -background] 4]] 2]/256]
      }
      if {"$colorBox(type)" == "rgb"} {
        .colorBox.red set $red
        .colorBox.green set $green
        .colorBox.blue set $blue
      } {
        if {"$colorBox(type)" == "hsv"} {
          set colorBoxHSV [ColorBoxRGBToHSV [expr $red*256] [expr $green*256] [expr $blue*256]]
          .colorBox.h set [format %.0f [expr [lindex $colorBoxHSV 0]*1000.0]]
          .colorBox.s set [format %.0f [expr [lindex $colorBoxHSV 1]*1000.0]]
          .colorBox.v set [format %.0f [expr [lindex $colorBoxHSV 2]*1000.0]]
        }
      }
    }
  }
  .colorBox.red config \
    -command "ColorBoxSetRGBColor $colorBoxMessage \"$colorBoxTargetW\""
  .colorBox.green config \
    -command "ColorBoxSetRGBColor $colorBoxMessage \"$colorBoxTargetW\""
  .colorBox.blue config \
    -command "ColorBoxSetRGBColor $colorBoxMessage \"$colorBoxTargetW\""
  .colorBox.h config \
    -command "ColorBoxSetHSVColor $colorBoxMessage \"$colorBoxTargetW\""
  .colorBox.s config \
    -command "ColorBoxSetHSVColor $colorBoxMessage \"$colorBoxTargetW\""
  .colorBox.v config \
    -command "ColorBoxSetHSVColor $colorBoxMessage \"$colorBoxTargetW\""
}

##########
# Procedure: ColorBoxSetRGBColor
# Description: set the color as RGB value
# Arguments: colorBoxMessage - the message for the color
#            colorBoxTargetW - the widget we configure
#            colorBoxValue - the passed value from scale
# Returns: none
# Sideeffects: none
##########
proc ColorBoxSetRGBColor {colorBoxMessage colorBoxTargetW colorBoxValue} {# xf ignore me 6
  global colorBox

  ColorBoxSetColor $colorBoxMessage $colorBoxTargetW rgb \
    [format #%02x%02x%02x [.colorBox.red get] \
      [.colorBox.green get] [.colorBox.blue get]]
  ColorBoxSetPaletteList [format #%02x%02x%02x [.colorBox.red get] \
    [.colorBox.green get] [.colorBox.blue get]]
}

##########
# Procedure: ColorBoxSetHSVColor
# Description: set the color as HSV value
# Arguments: colorBoxMessage - the message for the color
#            colorBoxTargetW - the widget we configure
#            colorBoxValue - the passed value from scale
# Returns: none
# Sideeffects: none
##########
proc ColorBoxSetHSVColor {colorBoxMessage colorBoxTargetW colorBoxValue} {# xf ignore me 6
  global colorBox

  set colorBoxRGB [ColorBoxHSVToRGB [expr [.colorBox.h get]/1000.0] [expr [.colorBox.s get]/1000.0] [expr [.colorBox.v get]/1000.0]]
  ColorBoxSetColor $colorBoxMessage $colorBoxTargetW hsv \
    [format #%04x%04x%04x [lindex $colorBoxRGB 0] [lindex $colorBoxRGB 1] [lindex $colorBoxRGB 2]]
  ColorBoxSetPaletteList [format #%04x%04x%04x [lindex $colorBoxRGB 0] [lindex $colorBoxRGB 1] [lindex $colorBoxRGB 2]]
}

##########
# Procedure: ColorBoxSetPalette
# Description: set the palette color
# Arguments: colorBoxMessage - the message for the color
#            colorBoxTargetW - the widget we configure
#            colorBoxElement - the palette element
# Returns: none
# Sideeffects: none
##########
proc ColorBoxSetPalette {colorBoxMessage colorBoxTargetW colorBoxElement} {# xf ignore me 6
  global colorBox

  set colorBox(paletteNr) $colorBoxElement
  ColorBoxSetColor $colorBoxMessage $colorBoxTargetW palette \
    [lindex [.colorBox.palette.palette$colorBoxElement config -background] 4]
}

##########
# Procedure: ColorBoxSetPaletteList
# Description: set the palette color list
# Arguments: colorBoxValue - the new palette value
# Returns: none
# Sideeffects: none
##########
proc ColorBoxSetPaletteList {colorBoxValue} {# xf ignore me 6
  global colorBox

  catch ".colorBox.palette.palette$colorBox(paletteNr) config \
      -activebackground $colorBoxValue"
  catch ".colorBox.palette.palette$colorBox(paletteNr) config \
      -background $colorBoxValue"
  set colorBox(palette) \
    [lreplace $colorBox(palette) $colorBox(paletteNr) $colorBox(paletteNr) \
      $colorBoxValue]
}

##########
# Procedure: ColorBoxShowSlides
# Description: select color for color composing
# Arguments: colorBoxMessage - the message for the color
#            colorBoxTargetW - the widget we configure
# Returns: none
# Sideeffects: none
##########
proc ColorBoxShowSlides {colorBoxMessage colorBoxTargetW} {# xf ignore me 6
  global colorBox

  catch "pack unpack .colorBox.frame1"
  catch "pack unpack .colorBox.frame2"
  catch "pack unpack .colorBox.current"
  catch "pack unpack .colorBox.demo"
  catch "pack unpack .colorBox.h"
  catch "pack unpack .colorBox.s"
  catch "pack unpack .colorBox.v"
  catch "pack unpack .colorBox.red"
  catch "pack unpack .colorBox.green"
  catch "pack unpack .colorBox.blue"
  catch "pack unpack .colorBox.colors"
  case $colorBox(type) in {
    {rgb} {
      pack append .colorBox \
                  .colorBox.frame1 {bottom fillx} \
                  .colorBox.frame2 {bottom fillx} \
                  .colorBox.current {bottom fillx} \
                  .colorBox.palette {bottom fillx} \
                  .colorBox.red {top fillx} \
                  .colorBox.green {top fillx} \
                  .colorBox.blue {top fillx} \
                  .colorBox.demo {bottom fill expand}
    }
    {hsv} {
      pack append .colorBox \
                  .colorBox.frame1 {bottom fillx} \
                  .colorBox.frame2 {bottom fillx} \
                  .colorBox.current {bottom fillx} \
                  .colorBox.palette {bottom fillx} \
                  .colorBox.h {top fillx} \
                  .colorBox.s {top fillx} \
                  .colorBox.v {top fillx} \
                  .colorBox.demo {bottom fill expand}
    }
    {list} {
      pack append .colorBox \
                  .colorBox.frame1 {bottom fillx} \
                  .colorBox.frame2 {bottom fillx} \
                  .colorBox.current {bottom fillx} \
                  .colorBox.palette {bottom fillx} \
                  .colorBox.demo {bottom fillx} \
                  .colorBox.colors {top fill expand}
    }
  }
  if {[string match "*oreground*" $colorBoxMessage]} {
    ColorBoxSetColor $colorBoxMessage $colorBoxTargetW text \
      [lindex [.colorBox.demo config -foreground] 4]
  } {
    ColorBoxSetColor $colorBoxMessage $colorBoxTargetW text \
      [lindex [.colorBox.demo config -background] 4]
  }
}

##########
# Procedure: ColorBoxHSVToRGB
# Description: modify hsv color values to rgb values
# Arguments: colorBoxHue - the hue
#            colorBoxSat - the saturation
#            colorBoxValue - the value
# Returns: none
# Sideeffects: none
##########
proc ColorBoxHSVToRGB {colorBoxHue colorBoxSat colorBoxValue} {# xf ignore me 6
# The HSV <-> RGB converting routines are from the
# tcolor demo that is part of the demo site of Tk.

  set colorBoxV [format %.0f [expr 65535.0*$colorBoxValue]]
  if {$colorBoxSat == 0} {
    return "$colorBoxV $colorBoxV $colorBoxV"
  } else {
    set colorBoxHue [expr $colorBoxHue*6.0]
    if {$colorBoxHue >= 6.0} {
      set colorBoxHue 0.0
    }
    scan $colorBoxHue. %d i
    set colorBoxF [expr $colorBoxHue-$i]
    set colorBoxP [format %.0f [expr {65535.0*$colorBoxValue*(1 - $colorBoxSat)}]]
    set colorBoxQ [format %.0f [expr {65535.0*$colorBoxValue*(1 - ($colorBoxSat*$colorBoxF))}]]
    set colorBoxT [format %.0f [expr {65535.0*$colorBoxValue*(1 - ($colorBoxSat*(1 - $colorBoxF)))}]]
    case $i \
      0 {return "$colorBoxV $colorBoxT $colorBoxP"} \
      1 {return "$colorBoxQ $colorBoxV $colorBoxP"} \
      2 {return "$colorBoxP $colorBoxV $colorBoxT"} \
      3 {return "$colorBoxP $colorBoxQ $colorBoxV"} \
      4 {return "$colorBoxT $colorBoxP $colorBoxV"} \
      5 {return "$colorBoxV $colorBoxP $colorBoxQ"}
    error "i value $i is out of range"
  }
}

##########
# Procedure: ColorBoxRGBToHSV
# Description: modify rgb color values to hsv values
# Arguments: colorBoxRed - the red value
#            colorBoxGreen - the green value
#            colorBoxBlue - the blue value
# Returns: none
# Sideeffects: none
##########
proc ColorBoxRGBToHSV {colorBoxRed colorBoxGreen colorBoxBlue} {# xf ignore me 6
# The HSV <-> RGB converting routines are from the
# tcolor demo that is part of the demo site of Tk.

  if {$colorBoxRed > $colorBoxGreen} {
    set colorBoxMax $colorBoxRed.0
    set colorBoxMin $colorBoxGreen.0
  } else {
    set colorBoxMax $colorBoxGreen.0
    set colorBoxMin $colorBoxRed.0
  }
  if {$colorBoxBlue > $colorBoxMax} {
    set colorBoxMax $colorBoxBlue.0
  } else {
    if {$colorBoxBlue < $colorBoxMin} {
      set colorBoxMin $colorBoxBlue.0
    }
  }
  set range [expr $colorBoxMax-$colorBoxMin]
  if {$colorBoxMax == 0} {
    set colorBoxSat 0
  } else {
    set colorBoxSat [expr {($colorBoxMax-$colorBoxMin)/$colorBoxMax}]
  }
  if {$colorBoxSat == 0} {
    set colorBoxHue 0
  } else {
    set colorBoxRC [expr {($colorBoxMax - $colorBoxRed)/$range}]
    set colorBoxGC [expr {($colorBoxMax - $colorBoxGreen)/$range}]
    set colorBoxBC [expr {($colorBoxMax - $colorBoxBlue)/$range}]
    if {$colorBoxRed == $colorBoxMax} {
      set colorBoxHue [expr {.166667*($colorBoxBC - $colorBoxGC)}]
    } else {
      if {$colorBoxGreen == $colorBoxMax} {
        set colorBoxHue [expr {.166667*(2 + $colorBoxRC - $colorBoxBC)}]
      } else {
        set colorBoxHue [expr {.166667*(4 + $colorBoxGC - $colorBoxRC)}]
      }
    }
  }
  return [list $colorBoxHue $colorBoxSat [expr {$colorBoxMax/65535}]]
}

# eof
#

