# use_startup.tcl
# 
# Copyright (c) 1994 R"udiger Franke
# All Rights Reserved.
# 
# Redistribution and use in any form, with or without modification, 
# is permitted, provided that the following conditions are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in other form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. All advertising materials mentioning features or use of this software
#    must display the following acknowledgement:
#       This product includes software developed by R"udiger Franke.
# 4. The name of the author may not be used to endorse or promote products
#    derived from this software without specific prior written permission.
# 
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
# IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

#
# constructor for "use_startup"
#
proc use_startup {w  args} {
  upvar #0 $w this

  # data initializations

  set this(use_startup) $w
  set this(text) $w.text
  set this(yscroll) $w.yscroll
  set this(buttons) $w.buttons
  
  # widget creations

  frame $this(use_startup) 
  text $this(text)  \
    -borderwidth "2" \
    -relief "sunken" \
    -yscrollcommand "$this(yscroll) set"
  scrollbar $this(yscroll)  \
    -command "$this(text) yview" \
    -relief "sunken"
  use_buttons $this(buttons) $w {Load Save} {}
  
  # widget layouting

  blt_table $w \
    $this(buttons) 1,0 -columnspan 2 -fill x -pady 2m \
    $this(text) 0,0 -fill both \
    $this(yscroll) 0,1 -fill y
  blt_table column $w configure 1 -resize none
  blt_table row $w configure 1 -resize none
  
  
  useCreateComponent use_startup $w $args


  return $w
}

#
# method "load"
#
proc use_startup::load {w } {
  upvar #0 $w this

  global use use_library
  
  set fname $use(wd)\/startup
  $this(text) delete 0.0 end
  if {[catch {glob $use(wd)\/startup}] == 0} {
    set fid [open $fname r]
    $this(text) insert 0.0 [read $fid]
    close $fid
  } else {
    $this(text) insert end "#![exec which wish] -f\n"
    $this(text) insert end "[use_filehead startup]\n"
    $this(text) insert end "\n# install applications code\n"
    $this(text) insert end \
      "\nif {!\[info exists useBuiltInCode\]} {\n"
    $this(text) insert end \
      "  source $use_library\/use_basic.tcl\n"
    $this(text) insert end \
      "  lappend auto_path $use(wd)\n}\n"
    $this(text) insert end \
      "\n#\n# create applications startup interface\n#\n\n"
  }
  $this(text) yview -pickplace {insert - 15 lines}
}

#
# method "save"
#
proc use_startup::save {w } {
  upvar #0 $w this

  global use
  
  if {[$this(text) get 1.0] != "#"} {
    error "First line should contain a comment."
  }
  
  set fname $use(wd)\/startup
  use_bakfile $fname
  set fid [open $fname w]
  puts $fid [$this(text) get 0.0 end] nonewline
  close $fid
  
  exec chmod +x $fname
}

