#!/bin/sh
# Tcl-based GUI installation program

# Copyright (c) 2000, Red Hat, Inc.
# 
# This file is part of Source-Navigator.
# 
# Source-Navigator is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 2, or (at your option)
# any later version.
# 
# Source-Navigator is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
# 
# You should have received a copy of the GNU General Public License along
# with Source-Navigator; see the file COPYING.  If not, write to
# the Free Software Foundation, 59 Temple Place - Suite 330, Boston,
# MA 02111-1307, USA.


# These two lines are treated as a single comment in wish. \
TCL_LIBRARY=share/tcl8.1

# These two lines also. \
export TCL_LIBRARY

# Likewise.  Now load this script back into wish. \
exec bin/wish "$0" "$@"

set product(name) "Source-Navigator"
set product(homepage) "http://support.cygnus.com/"
set product(version) "4.5.2"

proc show_splash_screen { } {
  global product

  set w .splash

  toplevel $w -bg white
  wm resizable $w 0 0 
  wm title $w "$product(name) $product(version)"
  wm transient $w .
  catch { 
    image create photo sn-logo -file share/bitmaps/hourglass.gif -palette 0/0/8
    label $w.image -image sn-logo -bg white
  }
  text $w.copyright -height 7 -width 60 \
      -relief flat -highlightthickness 0 -takefocus 0
  catch {$w.copyright config -font {Helvetica 12 bold}}
  $w.copyright insert end "(C) Copyright 1997-2000 Red Hat, Inc.\nAll rights reserved.\n\n"

  $w.copyright insert end "Tel: +1 408 542 9600\t\tFax: +1 408 542 9699\nEmail: support@cygnus.com\t$product(homepage)"
  pack $w.image $w.copyright -side left
  bind $w <1> "destroy $w"

  #exit program when window is closed
  wm protocol . WM_DELETE_WINDOW "exit 1"

  # taken from dialog code: Withdraw the window, update all the
  # geometry, and center the window in the display.
  wm withdraw .
  wm withdraw $w
  update idletasks
  set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
      - [winfo vrootx [winfo parent $w]]]
  set y [expr [winfo screenheight $w]/3 - [winfo reqheight $w]/2 \
      - [winfo vrooty [winfo parent $w]]]
  wm geom $w +$x+$y
  wm deiconify $w
  update idletasks
}

proc create_install_window { } {
  global product

  # What this does is set the size of the main window.  The content
  # frame within the window will be the dummy "null" at first, and
  # then other views can be switched in (via switch_window) to update
  # the display.
  wm geometry . 450x250
  frame .top
  pack .top -side top -expand yes -fill both
  frame .bot 
  pack .bot -side bottom -expand yes -fill both
  wm title . "$product(name) $product(version) Installation"
  switch_window

  # set window beneath splash screen, centered.
  wm withdraw .
  update idletasks
  set x [expr [winfo screenwidth .]/2 - 225 - [winfo vrootx .]]
  if {[winfo exists .splash]} {
    set y [expr [winfo rooty .splash] + [winfo reqheight .splash] + 20]
  } else {
    set y [expr [winfo screenheight .]/2 - 125 - [winfo vrooty .]]
  }
  wm geom . +$x+$y
}

proc switch_window {{w null}} {
  global cur_window

  if {[info exists cur_window] && $cur_window != "null"} { 
    pack forget $cur_window 
  }
  if {$w != "null"} {
    pack $w -fill both -expand y
    $w config -relief ridge -borderwidth 2
    wm deiconify .
  }

  set cur_window $w
}

proc wait_for_switch { } {
  tkwait variable cur_window
}

proc labelled_entry { w txt var } {
  frame $w
  label $w.l -text $txt
  entry $w.e -textvariable $var
  pack $w.e -expand yes -fill x -side right
  pack $w.l -fill both -expand y
}

proc handle_ok { w } {
  global cur_window

  if {[winfo exists $cur_window.ok]} {
    $cur_window.ok invoke
  }
}

proc create_switch_views { } {
  global installhome cdkey

  frame .installdir 
  label .installdir.l -text "Enter Installation Target Directory:"
  entry .installdir.e -textvariable installhome
  button .installdir.ok -text "OK" -command {switch_window}
  pack .installdir.l -expand yes -fill both -side top
  pack .installdir.e -expand yes -fill x -side top
  pack .installdir.ok -anchor e -side top

  frame .mailhost
  label .mailhost.l -text "Submit Source-Navigator bug reports using..."
  frame .mailhost.f
  labelled_entry .mailhost.f.e "Mail Host:" mailhost(name)
  pack .mailhost.f.e -expand yes -fill x
  button .mailhost.ok -text "OK" -command {switch_window}
  pack .mailhost.ok -anchor e -side bottom
  pack .mailhost.f -expand yes -side bottom -fill x
  pack .mailhost.l -expand yes  

  frame .copying
  label .copying.l -text "Copying Kit..."
  scale .copying.s -from 0 -to 100 -variable scalevar -orient horiz -showvalue 0 -state disabled
  label .copying.f -text "" -textvariable linevar 
  catch {.copying.f config -font {Helvetica 10}}
  pack .copying.l .copying.s .copying.f -side top -fill x

  frame .demos
  label .demos.l -text "Select demonstration projects to install:"
  frame .demos.check
  checkbutton .demos.check.cpp -text {C/C++ Project} \
      -onvalue c++_demo -offvalue "" -variable demo(C++) 
  checkbutton .demos.check.jav -text {Java Project} \
      -onvalue jav_demo -offvalue "" -variable demo(Java)
  checkbutton .demos.check.for -text {Fortran Project} \
      -onvalue for_demo -offvalue "" -variable demo(Fortran)
  checkbutton .demos.check.cob -text {Cobol Project} \
      -onvalue cob_demo -offvalue "" -variable demo(Cobol)
  checkbutton .demos.check.asm -text {Assembly Project} \
      -onvalue asm_demo -offvalue "" -variable demo(Assembly)
  checkbutton .demos.check.monop -text {Monop game} \
      -onvalue monop -offvalue "" -variable demo(Monop)
  pack .demos.check.cpp .demos.check.jav .demos.check.for \
      .demos.check.cob .demos.check.asm .demos.check.monop -side top -anchor w
  button .demos.ok -text "OK" -command {switch_window}
  pack .demos.ok -anchor e -side bottom
  pack .demos.check -expand yes -side bottom
  pack .demos.l -expand yes -fill x
  
  frame .showlic
  text .showlic.t -yscrollcommand {.showlic.sb set} \
	  -highlightthickness 0 -takefocus 0 -wrap word
  catch {.showlic.t config -font {Helvetica 12}}
  catch { 
    set F [open COPYING r]
    while {[gets $F str] != -1} {
        if {$str == ""} { 
	    .showlic.t insert end "\n\n" 
        } else {
	    .showlic.t insert end "$str "
        }
    }
    close $F
  }
  .showlic.t configure -state disabled

  scrollbar .showlic.sb -orient vertical -command {.showlic.t yview}
  frame .showlic.bts -relief flat
  button .showlic.bts.a -text "Accept License" \
	  -command {set acclic 1; switch_window}
  button .showlic.bts.d -text "Decline" -command {set acclic 0; switch_window}
  pack .showlic.bts.a .showlic.bts.d -expand yes -side left -pady 5
  pack .showlic.bts -side bottom -fill x
  pack .showlic.sb -side left -fill y
  pack .showlic.t -fill both
  bind . <Return> {handle_ok %W}
}

proc enable_frame { f var } {
  foreach w [winfo children $f] {
    if {$var == "y"} {
      $w.e config -state normal -foreground black
      $w.l config -foreground black
    } else {
      $w.e config -state disabled -foreground #a3a3a3
      $w.l config -foreground #a3a3a3
    }
  }
}

proc get_install_dir { } {
  global installhome env
  if {![info exists env(HOME)] || $env(HOME) == "" || $env(HOME) == "/"} {
    set installhome /usr/local/snavigator
  } else {
    set installhome $env(HOME)/snavigator
  }

  switch_window .installdir
  wait_for_switch
  
  # strip a trailing slash, if any.
  if {[lindex [split $installhome /] end] == {}} {
	# This path has a trailing slash.
	set installhome [join [lreplace [split $installhome /] end end] /]
  }

  # try to create directory if it doesn't already exist
  if [file isdirectory $installhome] {
    if {[tk_dialog .inst_direx {Existing Directory} \
	"The directory \"$installhome\" already exists.  
Are you sure you want to place Source-Navigator in this directory?" \
	{} 0 {No, Please Install Elsewhere} {Yes}] == 0} {
      get_install_dir
      return
    }
  } else {
    if {[catch {exec mkdir -p $installhome}] != 0} {
      tk_dialog .inst_baddir {Couldn't Install} \
	  "I cannot create the directory \"$installhome\"." error 0 {OK}
      get_install_dir
      return
    }
  }
}

proc get_mailhost { } {
  global mailhost
  
  set mailhost(name) "mailhost"
  set mailhost(usemail) "y"
  enable_frame .mailhost.f $mailhost(usemail)  

  switch_window .mailhost
  wait_for_switch
  if {$mailhost(usemail) == "n"} {
    set mailhost(name) "www"
  }
}

proc get_demos { } {
  global demo env
  set demo(C++) ""
  set demo(Fortran) ""
  set demo(Java) ""
  set demo(Cobol) ""
  set demo(Assembly) ""
  set demo(Monop) ""
  
  switch_window .demos
  wait_for_switch
}

proc copy_file { from to perm } {
  global installhome
  # copy over string file
  file copy -force $from $installhome/$to
  exec chmod $perm $installhome/$to
}

proc set_copying_line { text } {
  global linevar
  set linevar ""
  .copying.l config -text $text
  update
}

proc copy_kit { } {
  global installhome scalevar linevar

  set lines [exec find COPYING README.TXT bin html share -type f -print | wc -l]
  set scalevar 0

  .copying.s config -to $lines

  switch_window .copying
  update

  # If we had a decent version of find(1) on AIX, we could use find -prune.
  # But we don't, so prune the share/demos subtree with grep -v.

  set F [open "|find COPYING README.TXT bin html share -type f -print | grep -v share/demos | grep -v wish | grep -v cdkey_mangle | cpio -pdvmu $installhome |& cat" r]
  while {[gets $F linevar] != -1} {
    incr scalevar
    regsub "^$installhome" $linevar "..." linevar
    update
  }
  catch { close $F }
}

proc set_profile { } {
  global installhome mailhost

  set_copying_line "Creating .../share/etc/profile"
  # make directory 
  catch { exec mkdir $installhome/share/etc }

  set F [open $installhome/share/etc/profile w]
  puts $F "sn_language:english"
  puts $F "encoding:iso8859-1"
  puts $F "sn_mailhost:$mailhost(name)"
  close $F
}

proc build_demo_project { proj } {
    global installhome project_list

    set demodir $installhome/share/demos

    if {[file isdirectory $demodir/$proj] && \
	    ![file isdirectory $demodir/$proj/.snprj]} {
	set cwd [pwd]
	cd [file join $demodir $proj]
	catch { exec $installhome/bin/snavigator --create --batchmode -p $proj}
	cd $cwd

	lappend project_list $demodir/$proj/$proj.proj
    }
}

proc copy_demos { } {
  global demo installhome project_list
  
  set project_list ""
  set demodir $installhome/share/demos
  set srcdir [file join [pwd] [file join share demos]]

  foreach d { C++ Java Fortran Cobol Assembly Monop } {
      if {$demo($d) != ""} {
	  set_copying_line "Expanding $d demo project..."
	  set proj $demo($d)
	  catch { file mkdir $demodir }
	  cd $demodir
	  catch { exec gzip -d -c [file join $srcdir $proj.tar.gz] | tar xf - }
      } 
  }
}

proc set_permissions { } {
  global installhome project_list env

  # Some platforms return a status code of 1 from id.
  catch {exec id} outstr
  if {$outstr != ""} {
      if [regexp {[^=]+=([0-9]+)[^(]*\(([^)]+)} $outstr null uid uname] {
		  set_copying_line "Setting file ownership..."
		  catch { exec chown -R $uname $installhome }
      }
  }

  set_copying_line "Setting file permissions..."
  exec chmod -R u+w,a+r,go-w $installhome
  set_copying_line "Setting directory permissions..."
  exec find $installhome -type d -exec chmod 755 \{\} \;

  # This directory may not exist if no demos have been installed.
  catch {exec chmod -R a+rw $installhome/share/demos}

  exec chmod -R a+rx $installhome/bin
}

proc create_script { infile outfile } {
  global installhome

  set_copying_line "Making .../bin/$outfile"

  set F [open $installhome/bin/$outfile w [expr 0755]]
  puts $F "#!/bin/sh"
  puts $F "SN_HOME=$installhome"
  puts $F "export SN_HOME"
  puts $F "TCL_LIBRARY=\$SN_HOME/share/tcl8.1"
  puts $F "export TCL_LIBRARY"
  puts $F "\$SN_HOME/bin/hyper -file \$SN_HOME/share/etc/$infile -home \$SN_HOME \$*"
  close $F
} 

proc write_project_list { } {
    global project_list env

    set mode w
    set picklist [file join [file join $env(HOME) .sn] nav_projs.lst]

    # Do we have anything to do?
    if {$project_list == ""} {
	return
    }

    catch { set_copying_line "Creating project list..." }

    # If the project list already exists, read the list of existing
    # projects in.  We only want to add projects which aren't in this
    # file already.  NOTE: set the file mode to `a' for appending.

    if {[file exists $picklist]} {
	set mode a
	catch {
	    set F [open $picklist r]
	    while {[gets $F line] != -1} {
		set existing_projects($line) 1
	    }
	    close $F
	}
    }

    # Write out the project list.

    catch {
        file mkdir $env(HOME)/.sn
        set F [open $picklist $mode]
	
        if {![info exists existing_projects]} {
	    # No existing projects.
	    puts $F [join $project_list "\n"]
        } else {
	    # Be selective about which projects are added to
	    # the project list.
	    foreach proj $project_list {
		if {![info exists existing_projects($proj)]} {
		    puts $F $proj
		}
	    }
	} 
	close $F
    }
}

proc check_installation { } {
  global installhome demo rundemo

  set rundemo ""

  frame .check
  text .check.t -height 7 -width 50 \
      -relief flat -takefocus 0 -wrap word
  catch {.check.t config -font {Helvetica 12 bold}}
  .check.t insert end "Source-Navigator installation is complete.\n\n"
  .check.t insert end "Please include $installhome/bin in your PATH "
  .check.t insert end "environment variable.\n\n"
  .check.t insert end "To start Source-Navigator, type:\n"
  .check.t insert end "\t$installhome/bin/snavigator\n"

  .check.t configure -state disabled

  frame .check.bts 
  button .check.bts.ok -text "Exit" -command {switch_window}
  pack .check.bts.ok -side right -anchor e

  foreach d {C++ Java Fortran Cobol Assembly Monop} {
      if {$demo($d) != ""} {
	  button .check.bts.$demo($d) -text "$d" \
		  -command "cd $installhome/share/demos/$demo($d);
	                    exec $installhome/bin/snavigator $demo($d).proj &;
	  		    switch_window"
	  pack .check.bts.$demo($d) -side left -expand 1 -fill x -anchor w
      }
  } 
  
  pack .check.bts -side bottom -fill x
  pack .check.t -expand yes -fill y

  switch_window .check
  wait_for_switch
}

proc view_license { } {
    global acclic
    switch_window .showlic
    wait_for_switch
    if {$acclic == 0} {
	exit
    }
}

show_splash_screen
# wait ten seconds, and then the splash screen goes away
after 10000 { catch { destroy .splash }}

create_install_window
create_switch_views
set project_list ""

view_license
get_install_dir
get_mailhost
get_demos
copy_kit
set_profile
create_script navigato snavigator
copy_demos
set_permissions

write_project_list

set geometry [split [wm geometry .] "=x+-"]
set newx [expr [lindex $geometry 0] + 110]
set newoffset [expr [lindex $geometry 2] - 55]

wm geometry . ${newx}x[lindex $geometry 1]+${newoffset}+[lindex $geometry 3]

check_installation
exit
