#!/bin/sh
# The backslash makes the next line a comment in Tcl \
exec wish -f "$0" ${1+"$@"}

#$Id: install.tcl,v 1.12 1995/10/28 12:23:16 krischan Exp $
# LAST EDIT: Sat Oct 28 13:23:00 1995 by Christian Krone (gutamil.v12.de!krischan) 

set font(bold) "-adobe-new century schoolbook-bold-r-normal--*-120-*"

proc welcome {} {
  putAus "Welcome to the Installation Tool of <B>patience-1.8</B>

There are good chances, that a call of\
<C-make {Make Installation} install>Make/Make Installation</C> will install
everything at its proper places.
If you want finer control, start with browsing through the\
<C-.menu.config.m post %X %Y>Configure</C> and
<C-.menu.config.m.appDef post %X %Y>Configure/app-default</C> menus.\
There you can e.g. switch to english
as default language of the game by\
<C-.menu.config.m.appDef.sprache post %X %Y>Configure/app-default/sprache</C>.
You can create the patience executable by\
<C-make {Make Patience} patience>Make/Make Patience</C>.
If you want to play battle solitaires with players on remote hosts, 
make the patience daemon by\
<C-make {Make Dppatd} dppatd>Make/Make Dppatd</C> (You need Tcl-DP for that).
A test game can be played by \
<C-make {(Make then) Start}>Make/(Make then) Start</C>.
As already mentioned, an installation is launched by\
<C-make {Make Installation} install>Make/Make Installation</C>.
"

checkNoweb
checkDpwish I
checkLibDir

putAus "Have fun, krischan
krischan@cs.tu-berlin.de
Christian Krone, Varziner Str. 12, D-12161 Berlin
"
}

proc confMenueEntry {m index args} {
  set tearOffs [info commands .tearoff*]
  if {[llength $tearOffs]} {
    set m "$m $tearOffs"
  }
  foreach menu $m {
    catch {eval $menu entryconfigure [list $index] $args}
  }
}

proc checkVersion {} {
  global tk_version argv0

  if {$tk_version < 4.0} {
    puts stderr "
The installation tool must be interpreted by a wish with a version
number at least 4.0; the current wish has only version $tk_version.

If you have a newer wish, but with another name (like wish4.0), just
restart this program by e.g. \"wish4.0 $argv0\".

If not, you have to look for a newer wish or install the patience
by means of the following three steps:
- edit the Makefile, check lines 10, 11 and 20
- edit app-default, uncomment line 26 (if you like english)
- make install
See also the file INSTALL-english (or INSTALL-deutsch).
Note: The game itself can be interpreted by an old wish very well,
although I recommend to upgrade to a newer wish anyway...
"
    exit 22
  }
}

proc mkGUI {} {
  global env make_var app_default font

  frame .menu -relief raised -borderwidth 1
  pack  .menu -fill x

  menubutton .menu.make -text Make -menu .menu.make.m
  menu .menu.make.m
  .menu.make.m add command -label "Make Patience" \
      -com "make {Make Patience} patience"
  .menu.make.m add command -label "Make Patc" \
      -com "make {Make Patc} patc"
  .menu.make.m add command -label "Make Dppatd" \
      -com "make {Make Dppatd} dppatd"
  .menu.make.m add command -label "Make Documentation" \
      -com "make {Make Documentation} doc"
  .menu.make.m add command -label "Make Textfiles" \
      -com "make {Make Textfiles} texte"
  .menu.make.m add separator
  .menu.make.m add command -label "(Make then) Start" -acc "^X" \
      -com "make {(Make then) Start}"
  .menu.make.m add separator
  .menu.make.m add command -label "Make Installation" \
      -com "make {Make Installation} install"
  .menu.make.m add separator
  .menu.make.m add command -label "Quit"              -com "quit" -acc "^C"

  menubutton .menu.config -text Configure -menu .menu.config.m
  menu .menu.config.m

  interpMenu     .menu.config.m interp
  libDirMenu     .menu.config.m libDir
  binDirMenu     .menu.config.m binDir
  optConfMenu    .menu.config.m optConf
  appDefaultMenu .menu.config.m appDef
  .menu.config.m add separator
  .menu.config.m add command -label "Save app-default" \
      -command "saveAppDefs"  -state disabled
  .menu.config.m add command -label "Save Makefile" \
      -command "saveMakefile" -state disabled
  trace variable make_var    w saveMakefileActiv
  trace variable app_default w saveAppDefsActiv

  pack .menu.make .menu.config -side left

  frame .aus
  text .aus.text -width 80 -borderwidth 2 -relief raised -setgrid true \
      -yscrollcommand {.aus.scroll set} -state disabled
  .aus.text tag configure B -font $font(bold)
  .aus.text tag configure C -font $font(bold) -underline 1
  scrollbar .aus.scroll -command {.aus.text yview}
  pack .aus.scroll -side right -fill y
  pack .aus.text  -side left -fill both -expand true
  pack .aus -fill both -expand 1

  bind . <Any-Enter>    {focus .aus}
  bind .aus <Control-x> {make "Make then Start"} 
  bind .aus <Control-c> {quit}
}

proc saveMakefileActiv {name1 name2 op} {
  confMenueEntry .menu.config.m "Save Makefile" -state normal
}

proc saveAppDefsActiv {name1 name2 op} {
  confMenueEntry .menu.config.m "Save app-default" -state normal
}

proc putAus {text} {
  global tagCom currTags

  .aus.text configure -state normal
  set currTags ""
  foreach textSegm [split $text <] {
    set insertText ""
    switch -glob -- $textSegm {
      ?>* {
	lappend currTags [string index $textSegm 0]
	set insertText [string range $textSegm 2 end]
      }
      ?-*>* {
	if {[regexp {^(.)-([^>]*)>(.*)$} $textSegm match tag comm anchor]} {
          lappend currTags $tag $comm
	  set tagCom($tag) $comm
	  set insertText $anchor
	}
      }
      /?>* {
        set tag [string index $textSegm 1]
	set tagIndex [lsearch -exact $currTags $tag]
	if {$tagIndex >= 0} {
	  if {[info exists tagCom($tag)]} {
	    set comm $tagCom($tag)
	    set comIndex [lsearch -exact $currTags $comm]
	    .aus.text tag bind $comm <Enter> {set oldCursor [.aus.text cget -cursor];
	    .aus.text config -cursor top_left_arrow}
	    .aus.text tag bind $comm <Leave> {.aus.text config -cursor $oldCursor}
	    .aus.text tag bind $comm <1>     "$comm"
	    unset tagCom($tag)
	    set currTags [lreplace $currTags $comIndex $comIndex]
	    set tagIndex [lsearch -exact $currTags $tag]
	  }
          set currTags [lreplace $currTags $tagIndex $tagIndex]
	} else {
	  puts stderr "End of unstarted tag $tag"
	}
	set insertText [string range $textSegm 3 end]
      }
      * {
	set insertText $textSegm
      }
    }
    .aus.text insert end $insertText $currTags
  }
  .aus.text insert end "\n"
  .aus.text configure -state disabled
  .aus.text see end
}

proc setOption {w text value} {
  confMenueEntry $w $text* -label "$text$value"
  putAus "Set [string trimright $text { :}] to $value"

  if {![string compare $text "Wish:    "]} {
    checkDpwish you
  }
}

proc optConfMenu {w c} {
  global make_var

  $w ad cascade -label "Optional configuration..." -menu $w.$c
  menu $w.$c
  foreach entry {
    {"Tcl/Tk-Libraries:    "   TKLIBS}
    {"C-Compiler-Flags:  "     CFLAGS}
    {"C-Compiler:            " CC}
  } {
  $w.$c add command -label "[lindex $entry 0]$make_var([lindex $entry 1])" \
    -command "configEdit \"[lindex $entry 0]\" make_var([lindex $entry 1]) $w.$c"
  }
}

proc interpMenu {w c} {
  global env make_var

  set text "Wish:    "
  $w add cascade -label "$text$make_var(WISH)" -menu $w.$c
  menu $w.$c
  
  set pathList [split $env(PATH) :]
  foreach dir $pathList {
    foreach wish [glob -nocomplain $dir/*wish*] {
      $w.$c add radiobutton -variable make_var(WISH) -label $wish \
	-command "setOption $w [list $text] $wish"
    }
  }
  $w.$c add separator
  $w.$c add command -label "Enter own wish..." \
      -command "configEdit \"$text\" make_var(WISH) $w"
}

proc libDirMenu {w c} {
  global make_var

  set text "LibDir:  $make_var(LIB_DIR)"
  $w add command -label $text -command {putAus "
Sorry, but you can change the LIB_DIR only by
- moving [pwd] complete to a new destination,
- cd into that directory, and
- restart this program from there.
"}
}

proc binDirMenu {w c} {
  global env make_var

  set text "BinDir:  "
  $w add cascade -label "$text$make_var(BIN_DIR)" -menu $w.$c
  menu $w.$c

  set pathList "/usr/games/bin  /usr/bin/X11   /usr/local/bin"
  foreach dir $pathList {
    $w.$c add radiobutton -variable make_var(BIN_DIR) -label $dir \
	-command "setOption $w [list $text] $dir"
  }
  $w.$c add separator
  $w.$c add command -label   "Enter own binDir..." \
      -command "configEdit \"$text\" make_var(BIN_DIR) $w"
}

proc lastIntCompare {a b} {
  set aLast [lindex $a [expr [llength $a]-1]]
  set bLast [lindex $b [expr [llength $b]-1]]
  return [expr $aLast-$bLast]
}

proc appDefaultMenu {w c} {
  global env app_default

  $w add cascade -label app_default -menu $w.$c
  menu $w.$c

  foreach resLineIndex [array names app_default line,*] {
    set res [string range $resLineIndex 5 end]
    lappend resLines [list $res $app_default(value,$res) \
	                        $app_default(line,$res)]
  }
  foreach res [lsort -command lastIntCompare $resLines] {
    set name  [lindex $res 0]
    set value [lindex $res 1]
    if {[info exists app_default(choise,$name)]} {
      switch -glob $app_default(choise,$name) {
	*..* {
	  if [regexp {([0-9]*)..([0-9]*)} $app_default(choise,$name) \
	      match from to] {
	    $w.$c add command -label "$name: $value" \
	      -command "resScale $w.$c \"$name: \" $name $from $to"
	  }
	}
	*,* {
	  $w.$c add cascade -label "$name: $value" -menu $w.$c.$name
	  menu $w.$c.$name
	  foreach choise [split $app_default(choise,$name) ,] {
	    $w.$c.$name add radiobutton \
		-variable app_default(value,$name) \
		-label $choise -command "setOption $w.$c \"$name: \" $choise"
	  }
	}
      }
    } else {
      $w.$c add command -label "$name: $value" \
        -command "configEdit \"$name: \" app_default(value,$name) $w.$c"
    }
  }
}

proc resScale {m text var from to} {
  global app_default

  set w $m.$var
  toplevel $w
  wm title $w $text
  wm iconname $w $text

  label $w.msg -text $text
  scale $w.scale -orient horizontal -length 280 -from $from -to $to \
	-bd 2 -command "set app_default(value,$var)"
  $w.scale set $app_default(value,$var)
  button $w.ok -text Okay \
    -command "destroy $w; setOption $m [list $text] \$app_default(value,$var)"

  pack $w.msg $w.scale $w.ok -fill x
}

proc configEdit {text variable w} {
  if {[catch {toplevel .conf}]} return

  frame .conf.top
  label .conf.top.name  -text $text
  entry .conf.top.entry -textvariable $variable -width 30
  pack .conf.top.name .conf.top.entry -side left

  button .conf.okay -text Okay -command "
    destroy .conf
    setOption $w \"$text\" \[set $variable]
  "
  pack .conf.top .conf.okay
  bind .conf           <Any-Enter> "focus .conf.top.entry"
  bind .conf.top.entry <Return>    ".conf.okay flash; .conf.okay invoke"
}

proc make {title args} {
  global make_var

  if {[llength $args]} {
    set appDefs  0
    set command  "make $args"
    set hyperCmd [list make $title $args]

  } else {
    set appDefs  1
    set command  "make patience && $make_var(WISH) -f ./patience"
    set hyperCmd [list make $title]
  }
  set text "has effect on the building of the program"
  if {![askForSave Makefile saveMakefile .menu.config.m $text]
      || ($appDefs
          && ![askForSave app-default saveAppDefs .menu.config.m $text])} {
    putAus "Command <B>$title</B> canceled."
    return
  }
  putAus "Start of <B>$command</B>."
  set inpipe [open "|/bin/sh -c \"$command </dev/null 2>&1; :\""]

  fileevent $inpipe readable [list fuelleMakeAus $inpipe $title $hyperCmd]
}

proc fuelleMakeAus {inpipe title command} {
  if {[eof $inpipe]} {
    putAus "End of <C-$command>$title</C>."  
    close $inpipe
  } else {
    putAus [gets $inpipe]
  }
}

proc readMakefile {} {
  global makefile make_var make_line

  set lineNo 0
  set makeAss "^\[ \t]*(\[A-Za-z0-9_]*)\[ \t]*=\[ \t]*(.*)$"
  if {![catch {open Makefile r} file]} {
    while {[gets $file this_line] >= 0} {
      lappend makefile $this_line
      if {[regexp $makeAss $this_line match var value]} {
	set make_line($var) $lineNo
	set make_var($var)  $value
      }
      incr lineNo
    }
    close $file
  }
  foreach default {
    {WISH    /usr/bin/wish}
    {BIN_DIR /usr/bin/X11}
    {LIB_DIR /usr/lib/X11}
    {TKLIBS  -L/usr/lib/tcl -ltk -ltcl -lm -lX11}
    {CFLAGS  -O -I/usr/include/tcl}
    {CC      cc}
  } {
    if {![info exists make_var([lindex $default 0])]} {
      set var [lindex $default 0]
      set val [lindex $default 1]
      set make_line($var) $lineNo
      set make_var($var)  $val
      lappend makefile "$var = $val"
      incr lineNo
      saveMakefileActiv makevar $var w
    }
  }
}

proc saveMakefile {} {
  global makefile make_var make_line

  foreach var [array names make_var] {
    set makefile [lreplace $makefile $make_line($var) $make_line($var) \
      " $var = $make_var($var)"]
  }
  if {[catch {open Makefile w} file]} {
    tk_dialog .t7 "Save Makefile" \
      "The file 'Makefile' cannot be opened. Reason: '$file' " \
      questhead 0 "Cancel"
  } else {
    foreach line $makefile {
      puts $file $line
    }
    close $file
    putAus "Makefile saved"
    confMenueEntry .menu.config.m "Save Makefile" -state disabled
  }
}

proc readAppDefs {} {
  global app_default app_defaults

  set lineNo 0
  set appDefRE "^\[^!]*\[.*](\[^ \t:.*]*)\[ \t]*:\[ \t]*(.*)$"
  set choiseRE "!\[ \t]*choise\\((\[^)]*)\\)\[ \t]*=\[ \t]*(.*)$"
  if {![catch {open app-default r} file]} {
    while {[gets $file line] >= 0} {
      lappend app_defaults $line
      if {[regexp $appDefRE $line match resource value]} {
	set app_default(line,$resource)  $lineNo
	set app_default(value,$resource) $value
      } elseif {[regexp $choiseRE $line match resource choise]} {
	set app_default(choise,$resource) $choise
      }
      incr lineNo
    }
    close $file
  }
}

proc saveAppDefs {} {
  global app_default app_defaults

  foreach resLineIndex [array names app_default line,*] {
    set res [string range $resLineIndex 5 end]
    set app_defaults [lreplace $app_defaults \
	$app_default(line,$res) $app_default(line,$res) \
	" *patience.$res:\t$app_default(value,$res)"]
  }
  if {[catch {open app-default w} file]} {
    tk_dialog .t6 "Save app-default" \
      "The file 'app-default' cannot be opened. Reason: '$file' " \
      questhead 0 "Cancel"
  } else {
    foreach line $app_defaults {
      puts $file $line
    }
    close $file
    putAus "app-default saved"
    confMenueEntry .menu.config.m "Save app-default" -state disabled
  }
}

proc askForSave {file saveProc m text} {
  if {[lindex [$m entryconfigure "Save $file" -state] 4] != "normal"} {
    return 1
  } else {
  set answer [tk_dialog .t1 "Save $file first" \
      "The file '$file' is modified, but not yet saved.
To be sure, that the configuration $text,
it is recommended to save the file first!" \
	questhead 2 "Cancel" "Continue" "Save first"]
    if {$answer == 2} {eval $saveProc}
    return $answer
  }
}

proc quit {} {
  set text "isn't gone with the wind"
  if {[askForSave Makefile    saveMakefile .menu.config.m $text] &&
      [askForSave app-default saveAppDefs  .menu.config.m $text]} {
    exit
  }
}

proc checkNoweb {} {
  global env make_var

  set found 0
  set pathList [split $env(PATH) :]
  foreach dir $pathList {
    if {[file executable $dir/notangle] && [file executable $dir/noweave]} {
      set found 1
    }
  }
  if {!$found} {
    confMenueEntry .menu.make.m "Make Documentation" -state disabled
    confMenueEntry .menu.make.m "Make Textfiles"     -state disabled

    putAus "Note:\
Since I didn't found the programs of the <B>NoWeb</B> package, I
disabled all the Makefile rules for generating the files out of the
<B>.nw</B>-source. This isn't that bad; you just can't look at the
pretty printed TeX output of the source and should (if ever) modify
directly the <B>.tcl</B> file instead of the <B>.nw</B> source.
"
    if {$make_var(WITH_NOWEB) != "test -z noweb"} {
      set make_var(WITH_NOWEB) "test -z noweb"
    }
  } else {
    if {$make_var(WITH_NOWEB) != "test noweb"} {
      putAus "Note:\
I reactivated all the Makefile rules for generating the files out
of the <B>.nw</B>-source, since I found the programs of the\
<B>NoWeb</B> package.
"
      set make_var(WITH_NOWEB) "test noweb"
}
  }
}

proc checkDpwish {who} {
  global dp_version app_default make_var

  if {![string compare $app_default(value,mitStreitbar) True]} return

  set command "exit \[catch {set dp_version}]"
  if {![catch {exec echo $command | $make_var(WISH)}]} {
    set app_default(value,mitStreitbar) True
    setOption .menu.config.m.appDef "mitStreitbar: " True
    putAus "Note:\
I set the default value of <B>mitStreitbar</B> to True, since $who select
a wish, that owns the functionality of Tcl-Dp.
"
  }
}

proc checkLibDir {} {
  global make_var

  if {[pwd] != $make_var(LIB_DIR)} {
    set make_var(LIB_DIR) [pwd]
    setOption .menu.config.m "LibDir:  " [pwd]
  }
}

checkVersion
readMakefile
readAppDefs
mkGUI
welcome
