#!/usr/local/bin/wish4.0
# procedures for an installation tool

global jinstall

######################################################################
# the following sets the header for each script.  note that %s marks the
# place where $jinstall(normallib) will be inserted.
set jinstall(preamble) {## begin boiler_header

if {[info exists env(JSTOOLS_LIB)]} {
  set jstools_library $env(JSTOOLS_LIB)
} else {
  set jstools_library %s
}

# add the jstools library to the library search path:

set auto_path [concat [list $jstools_library] $auto_path]

# check for ~/.tk and prepend it to the auto_path if it exists.
# that way the user can override and customise the jstools libraries.

if {[file isdirectory ~/.tk]} then {
  set auto_path [concat [list [glob ~/.tk]] $auto_path]
}

## end boiler_header
}
######################################################################

proc jinstall:show_help { help } {
  set ext 0
  set pref .jinstall_help
  while {[catch {toplevel $pref$ext}]} {
    incr ext
  }
  set w $pref$ext
  
  set text {}
  
  foreach part $help {
    append text $part
  }
  
  message $w.m -aspect 200 -text $text
  frame $w.f -height 5p
  label $w.l -text {(Click window to close.)}
  
  pack $w.m -padx 5p -pady 5p -fill both
  pack $w.f -fill x
  pack $w.l -fill x
  
  foreach widget [list $w.m $w.f $w.l] {
    bind $widget <Any-ButtonRelease> "destroy $w"
  }
  
  return $w
}

proc jinstall:mkentry { w prompt var default help } {
  global jinstall
  if ![info exists jinstall($var)] {set jinstall($var) $default}
  
  frame $w
  label $w.l \
    -anchor e \
    -width 30 \
    -text $prompt
  entry $w.e \
    -width 40 \
    -borderwidth 2p \
    -relief sunken \
    -textvariable jinstall($var)
  button $w.b \
    -text Help \
    -command [list jinstall:show_help $help]
  
  pack $w.l -side left
  pack $w.e -side left -fill x
  pack $w.b -side right -padx 8p -pady 2p
  
  return $w
}

proc jinstall:mkcheckbox { w prompt var default help } {
  global jinstall
  if ![info exists jinstall($var)] {set jinstall($var) $default}
  
  frame $w
  label $w.l \
    -anchor e \
    -width 30 \
    -text $prompt
  checkbutton $w.cb \
    -text Yes \
    -relief flat \
    -variable jinstall($var)
  button $w.b \
    -text Help \
    -command [list jinstall:show_help $help]
  
  pack $w.l -side left
  pack $w.cb -side left -fill x
  pack $w.b -side right -padx 8p -pady 2p
  
  return $w
}

proc jinstall:tab_ring { args } {
  # index of last widget
  set last [expr {[llength $args] - 1}]
  
  for {set i 0} {$i < $last} {incr i} {
    set this [lindex $args $i]
    set next [lindex $args [expr {$i + 1}]]
    bind $this <Tab> "focus $next"
    bind $next <Shift-Tab> "focus $this"
  }
  
  # ... and bind last to focus on first:
  set this [lindex $args $last]
  set next [lindex $args 0]
  bind $this <Tab> "focus $next"
  bind $next <Shift-Tab> "focus $this"
}

proc jinstall:log { string } {
  global jinstall
  if $jinstall(log) {
    puts stderr $string
  }
}

proc jinstall:read { filename } {
  set file [open $filename r]
  set string [read $file]
  close $file
  return $string
}

proc jinstall:mkdir { directory } {
  if ![file exists $directory] {
    if [catch [list exec mkdir -p $directory]] {
      jinstall:log "Unable to create directory $directory."
      return 1
    } else {
      jinstall:log "Making directory $directory."
      return 0
    }
  } else {
    if ![file isdirectory $directory] {
      jinstall:log \
        "File $directory exists, but is not a directory - cannot proceed."
      return 1
    } else {
      jinstall:log "Directory $directory already exists."
      return 0
    }
  }
}

proc jinstall:cp-r { file directory } {
  jinstall:log "Installing $file in $directory."
  if [catch [list exec cp -r $file $directory]] {
    jinstall:log "Unable to install $file in $directory."
    return 1
  } else {
    return 0
  }
}

proc jinstall:ln-s { source target } {
  jinstall:log "Making symbolic link from $source to $target."
  if [catch [list exec ln -s $source $target]] {
    jinstall:log "Unable to make link from $source to $target."
    return 1
  } else {
    return 0
  }
}

proc jinstall:install_script { script destination {interpreter wish} } {
  global jinstall
  
  jinstall:log "Installing script $script with preamble as $destination."
  
  if [catch {set scriptfile [open $script r]}] {
    jinstall:log "Unable to open $script for reading."
    return 1
  }
  
  set scripttext [read $scriptfile]
  
  # change interpreter name in magic line:
  regsub -- \
    "^#!\[^ \t\n\]*" \
    $scripttext \
    "#!$jinstall($interpreter)" \
    scripttext
  
  # replace preamble:
  set preamble [format $jinstall(preamble) $jinstall(normallib)]
  regsub -- \
    "\n## begin boiler_header\n.*\n## end boiler_header\n" \
    $scripttext \
    $preamble \
    scripttext
  
  if [catch {set outputfile [open $destination w]}] {
    jinstall:log "Unable to open $destination for writing."
    return 1
  }
  
  if [catch {puts $outputfile $scripttext}] {
    jinstall:log "Unable to write to $outputfile."
    return 1
  }
  close $outputfile
  
  if [catch {exec chmod 755 $destination}] {
    jinstall:log "Unable to set permissions on $destination."
    return 1
  }
  
  return 0
}

######################################################################

proc jinstall:cancel {} {
  exit 0
}

proc jinstall:install_jstools {} {
  global jinstall
  jinstall:mkdir $jinstall(normalbin)
  jinstall:mkdir $jinstall(normallib)
  
  foreach file [glob lib/j*] {
    jinstall:cp-r $file $jinstall(normallib)
  }
  jinstall:cp-r lib/samples $jinstall(normallib)
  auto_mkindex $jinstall(normallib) *.tcl
  
  foreach script {
    jabbrevs jalert jbrowser jcolname jcolrgb jconfirm jdoc jedit jfs
    jmore jprefs jprompt
  } {
    jinstall:install_script bin/$script $jinstall(normalbin)/$script
  }
  if $jinstall(installhtml) {
    jinstall:mkdir $jinstall(html)
    foreach file [glob html/*.html] {
      jinstall:cp-r $file $jinstall(html)
    }
    foreach directory {jeditmodes jstools panels} {
      jinstall:ln-s $jinstall(html) $jinstall(html)/$directory
    }
  }
  if $jinstall(installtoys) {
    jinstall:mkdir $jinstall(toybin)
    foreach script {
      jcalendar jhotlist jlaunchpad jmsgs jnewbrowser jpeople jrtgrep
    } {
      jinstall:install_script w-in-p/$script $jinstall(toybin)/$script
    }
    jinstall:install_script w-in-p/jperson $jinstall(toybin)/jperson tclsh
  }
  
  if {[tk_dialog .done \
    "Done" "Installation is complete." info 0 \
    "Quit" "Re­install"] == 0} {
    exit 0
  }
}

######################################################################

jinstall:mkentry .wish \
  {Path to wish (plus -f for 3.6):} \
  wish \
  "/usr/local/bin/wish4.0" \
  {
    {This is the full pathname to your wish interpreter, }
    {normally /usr/local/bin/wish4.0.  If you have a choice, }
    {you should specify a Tk 4.0 wish interpreter.}
    "\n\n"
    {If you specify a Tk 3.6 wish interpreter, you should add }
    {the `-f' flag here (e.g. `/usr/local/bin/wish -f').}
  }

jinstall:mkentry .normalbin \
  {Directory for production scripts:} \
  normalbin \
  "/usr/local/bin" \
  {
    {This is the pathname to the directory where you want to }
    {install the "production" (i.e., documented and reasonably }
    {robust) scripts, including jabbrevs, jbrowser, jdoc, jedit, }
    {jmore, and jprefs.  This is also where jhelp, which is }
    {obsolete, will be installed.  This is typically /usr/local/bin , }
    {or something like /usr/local/jstools-4.0b/bin .}
  }

jinstall:mkentry .normallib \
  {Directory for jstools libraries:} \
  normallib \
  "/usr/local/lib/jstools" \
  {
    {This is the pathname to the directory where you want to }
    {install the jstools libraries.  The Tcl library files will be }
    {installed here, and various other supporting files will be }
    {installed in subdirectories of this directory.  This is typically }
    {/usr/local/lib/jstools , or something like }
    {/usr/local/jstools-4.0b/lib.  The (jdoc-format) documentation is }
    {installed in the subdirectory "jdoc" of this directory, and the }
    {language databases are installed in subdirectory "jldb".}
  }

jinstall:mkcheckbox .installhtml \
  {Install documentation as HTML:} \
  installhtml \
  1 \
  {
    {If this is selected, then versions of the documentation converted }
    {to HTML format will be installed.}
    "\n\n"
    {Note that some formatting and hypertext information is lost in }
    {the translation to HTML, so the jdoc-format documentation (which }
    {is always installed) is more complete.}
  }


jinstall:mkentry .html \
  {Directory for HTML documentation:} \
  html \
  "/usr/local/lib/jstools/html" \
  {
    {This is the directory where versions of the jstools documentation }
    {converted to HTML will be installed.  You might want to put it with }
    {other HTML documents at your site.}
    "\n\n"
    {Note that some formatting and hypertext information is lost in }
    {the translation to HTML, so the jdoc-format documentation (which }
    {is always installed) is more complete.}
  }

jinstall:mkcheckbox .installtoys \
  {Install works­in­progress:} \
  installtoys \
  1 \
  {
    {If this is selected, then the jstools "works in progress" }
    {will be installed - applications that aren't yet quite ready }
    {for production work, as well as "toy" or "demo" applications.}
    "\n\n"
    {The term `Works­in­progress' isn't completely accurate, since }
    {I'm not doing any more work on some of them.}
  }

jinstall:mkentry .toybin \
  {Works-in-progress directory:} \
  toybin \
  "/usr/local/lib/jstools/w-in-p" \
  {
    {This is the pathname to the directory where you want to install the }
    {works­in­progress - unsupported jstools scripts.  At present that }
    {includes jcalendar, jhotlist, jlaunchpad, jmsgs, jnewbrowser, }
    {jpeople, jperson, and jrtgrep.  These can be installed in the same }
    {directory as the `production' scripts, but if you do that, please }
    {make sure your users know that they are not as robust as the }
    {documented scripts.}
    "\n\n"
    {The term `Works­in­progress' isn't completely accurate, since }
    {I'm not doing any more work on some of them.}
    "\n\n"
    {You can ignore this entry if you're not installing the }
    {works­in­progress.}
  }

jinstall:mkentry .tclsh \
  {Path to tclsh:} \
  tclsh \
  "/usr/local/bin/tclsh7.4" \
  {
    {This is the full pathname of your tclsh interpreter.  }
    {It's only used by jperson, so you can ignore this entry }
    {if you're not installing the works­in­progress.}
  }

pack [frame .topframe -height 5 -relief flat] -fill x
pack .wish -fill x
pack .normalbin -fill x
pack .normallib -fill x
pack .installhtml -fill x
pack .html -fill x
pack .installtoys -fill x
pack .toybin -fill x
pack .tclsh -fill x
pack [frame .bottomframe -height 5 -relief flat] -fill x
pack [frame .rule -relief sunken -height 2 -borderwidth 1] -fill x

jinstall:tab_ring .wish.e .normalbin.e .normallib.e .html.e .toybin.e .tclsh.e

######################################################################

frame .b
button .b.install -text Install -width 8 -command jinstall:install_jstools
button .b.cancel -text Cancel -width 8 -command jinstall:cancel
checkbutton .b.log -text {Print progress to stdout} \
  -relief flat \
  -variable jinstall(log)

frame .b.spacer -width 5p
pack .b.spacer -side right

pack .b.install .b.cancel -side right -padx 5p -pady 10p
pack .b.log -side left -padx 5p -pady 10p
pack .b -fill x

