#!/usr/bin/env wish8.3
# Tk-based package installation tool

global aqinstall

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

if {[info exists env(AQTOOLS_LIB)]} {
  set aq_library $env(AQTOOLS_LIB)
  set aq_pkg [file join $env(AQTOOLS_LIB) pkg]
} else {
  set aq_library %s
  set aq_pkg [file join $aq_library pkg]
}

# add the aq library to the library search path:

set auto_path  [concat  [list $aq_pkg]  [list $aq_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 aq libraries.

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

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

proc aqinst_parse_args {} {
  global argv script_args
  foreach {flag value} $argv {
    set script_args($flag) $value
  }
}

proc aqinst_show_help { help } {
  if {[catch {package require Tk}]} {
    foreach part $help {
      puts $part
    }
    puts ""
    return .help
  } else {
    set ext 0
    set pref .aqinstall_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 aqinst_ask_text { w prompt var default help } {
  global aqinstall script_args auto
  if {[info exists script_args(--$var)]} {
    set default $script_args(--$var)
  }
  set aqinstall($var) $default
  
  if {$auto} {
    return $w
  }
  
  if {[catch {package require Tk}]} {
    set done 0
    while {! $done} {
      puts "$prompt \[$default\]: "
      gets stdin input
      if {"x$input" == "x?"} {
        aqinst_show_help $help
        set done 0
      } else {
        set done 1
        if {[string length $input]} {
          set aqinstall($var) $input
        }
      }
    }
  } else {
    frame $w
    label $w.l \
      -anchor e \
      -width 30 \
      -text $prompt
    entry $w.e \
      -width 40 \
      -borderwidth 2p \
      -relief sunken \
      -textvariable aqinstall($var)
    button $w.b \
      -text Help \
      -command [list aqinst_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 aqinst_ask_yn { w prompt var default help } {
  global aqinstall script_args auto
  if {[info exists script_args(--$var)]} {
    set default $script_args(--$var)
  }
  set aqinstall($var) $default
  
  if {$auto} {
    return $w
  }
  
  if {[catch {package require Tk}]} {
    set done 0
    while {! $done} {
      puts "$prompt (y/n) \[[expr {$default ? "y" : "n"}]\]: "
      gets stdin input
      if {[string match {[yYnN]*} $input]} {
        set aqinstall($var) [string match {[yY]*} $input]
        set done 1
      } elseif {[string match "" $input]} {
        set aqinstall($var) $default
        set done 1
      } else {
        aqinst_show_help $help
        set done 0
      }
    }
  } else {
    frame $w
    label $w.l \
      -anchor e \
      -width 30 \
      -text $prompt
    checkbutton $w.cb \
      -text Yes \
      -relief flat \
      -variable aqinstall($var)
    button $w.b \
      -text Help \
      -command [list aqinst_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 aqinst_log { string } {
  global aqinstall
  if $aqinstall(verbose) {
    puts stderr $string
  }
}

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

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

proc aqinst_cp-r { file directory } {
  aqinst_log "Installing $file in $directory."
  if [catch {file copy -force -- $file $directory}] {
    aqinst_log "Unable to install $file in $directory."
    return 1
  } else {
    return 0
  }
}

proc aqinst_ln-s { source target } {
  global tcl_platform
  if {$tcl_platform(platform) == "unix"} {
    aqinst_log "Making symbolic link from $source to $target."
    if [catch [list exec ln -s $source $target]] {
      aqinst_log "Unable to make link from $source to $target."
      return 1
    } else {
      return 0
    }
  } else {
    aqinst_log "Copying $source to $target (can't make symbolic links)"
    if [catch {file copy -force -- $source $target}] {
      aqinst_log "Unable to copy $source to $target."
      return 1
    } else {
      return 0
    }
  }
}

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

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

proc aqinst_cancel {} {
  exit 0
}

proc aqinst_install_aqtools {} {
  global aqinstall
  global tcl_platform
  
  if $aqinstall(verbose) {
    catch {console show}
  }
  
  if {$tcl_platform(platform) == "windows"} {
    set ext .tcl
  } else {
    set ext ""
  }
  
  aqinst_mkdir $aqinstall(bin)
  aqinst_mkdir $aqinstall(lib)
  
  foreach file [glob [file join lib j*]] {
    aqinst_cp-r $file $aqinstall(lib)
  }
  aqinst_cp-r [file join lib aqdb] $aqinstall(lib)
  aqinst_cp-r [file join lib samples] $aqinstall(lib)
  aqinst_cp-r [file join lib bitmaps] $aqinstall(lib)
  aqinst_cp-r [file join lib pkg] $aqinstall(lib)
  aqinst_cp-r [file join lib jtagconvert] $aqinstall(lib)
  auto_mkindex $aqinstall(lib) *.tcl
  
  foreach script {
    aqabbrevs aqalert aqcolname aqcolrgb aqconfirm aqdoc aqedit aqfs
    aqmore aqprefs aqprompt
  } {
    aqinst_install_script \
      [file join bin $script] \
      [file join $aqinstall(bin) "$script$ext"]
  }
  if $aqinstall(installhtml) {
    if {$tcl_platform(platform) == "unix"} {
      aqinst_mkdir $aqinstall(html)
      foreach file [glob [file join html *.html]] {
        aqinst_cp-r $file $aqinstall(html)
      }
      foreach directory {jeditmodes aqdbmodes jstools panels} {
        aqinst_ln-s $aqinstall(html) [file join $aqinstall(html) $directory]
      }
    } else {
      aqinst_log \
        "Not installing HTML files - they're only installed under Unix"
      tk_dialog .html \
        "Notice" \
        "Not installing HTML files - they're only installed under Unix \
        since they depend on symbolic links." warning 0 OK
    }
  }
  if $aqinstall(installtoys) {
    aqinst_mkdir $aqinstall(toybin)
    foreach script {
      aqdb aqlaunchpad aqldbed aqmsgs aqqdcal aqtail
    } {
      aqinst_install_script \
        [file join w-in-p $script] \
        [file join $aqinstall(toybin) $script$ext]
    }
    aqinst_install_script \
      [file join w-in-p aqrtgrep] \
      [file join $aqinstall(toybin) aqrtgrep$ext] \
      tclsh
  }
  
  # just let the following fail if we don't have Tk:
  catch {
    if {[tk_dialog .done \
      "Done" "Installation is complete." info 0 \
      "Quit" "Re-install"] == 0} {
      exit 0
    }
  }
}

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

aqinst_parse_args

set auto 0
if {[info exists script_args(--auto)]} {
  set auto $script_args(--auto)
}

if {! [catch {package require Tk}]} {
  # if we're running under Tk, ignore --auto
  set auto 0
}

if {! $auto} {
  if {[catch {package require Tk}]} {
    puts "At the following prompts, you can type `?' for help, or just press"
    puts "Return to accept the default answers, shown in square brackets."
    puts ""
  }
}

global tcl_platform

if {[info exists script_args(--prefix)]} {
  set prefix $script_args(--prefix)
} else {
  if {$tcl_platform(platform) == "windows"} {
    set prefix C:/JSTOOLS
  } else {
    set prefix /usr/local
  }
}

aqinst_ask_text .wish \
  {Path to wish (at least 8.0):} \
  wish \
  /usr/bin/wish8.3 \
  {
    {This is the full pathname to your wish interpreter, }
    {typically /usr/bin/wish8.3 or /usr/local/bin/wish8.3.}
    "\n\n"
    {You can ignore this entry under Windows.}
  }

aqinst_ask_text .bin \
  {Directory for production scripts:} \
  bin \
  [file join $prefix bin] \
  {
    {This is the pathname to the directory where you want to }
    {install the "production" (i.e., documented and reasonably }
    {robust) scripts, such as aqedit, aqmore, and aqprefs.  This }
    {is typically /usr/local/bin , }
    {or something like /usr/local/aqtools-4.5/bin .}
    "\n\n"
    {Under Windows, scripts have ".tcl" appended.}
  }

aqinst_ask_text .lib \
  {Directory for aqtools libraries:} \
  lib \
  [file join $prefix lib aqtools] \
  {
    {This is the pathname to the directory where you want to }
    {install the aqtools 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/aqtools , or something like }
    {/usr/local/aqtools-4.5/lib.  The (jdoc-format) documentation is }
    {installed in the subdirectory "jdoc" of this directory, and }
    {currently, aqtools packages using `package require' are installed }
    {into the subdirectory "pkg" of this directory.}
  }

aqinst_ask_yn .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"
    {The HTML documents are only installed under UNIX.  If you're not }
    {using UNIX, you can view them from the "html" directory here }
    {(although some of the links won't work properly).}
    "\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.}
  }


aqinst_ask_text .html \
  {Directory for HTML documentation:} \
  html \
  [file join $prefix html] \
  {
    {This is the directory where versions of the aqtools 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 hypertext information is lost in }
    {the translation to HTML, so the jdoc-format documentation (which }
    {is always installed) is more complete.}
  }

aqinst_ask_yn .installtoys \
  {Install works-in-progress:} \
  installtoys \
  1 \
  {
    {If this is selected, then the aqtools "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.}
  }

aqinst_ask_text .toybin \
  {Works-in-progress directory:} \
  toybin \
  [file join $prefix lib aqtools w-in-p] \
  {
    {This is the pathname to the directory where you want to install the }
    {works-in-progress - unsupported aqtools scripts.  Some of these are }
    {on their way to being full-fledged aqtools apps (notably aqdb), but }
    {many are old apps I'm no longer working on, little bits of code that }
    {I needed for something, or proofs-of-concept.  }
    "\n\n"
    {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.}
    "\n\n"
    {Under Windows, scripts have ".tcl" appended.}
  }

aqinst_ask_text .tclsh \
  {Path to tclsh:} \
  tclsh \
  /usr/bin/tclsh8.3 \
  {
    {This is the full pathname of your tclsh interpreter.  }
    {It's only used by aqrtgrep, so you can }
    {ignore this entry if you're not installing the }
    {works-in-progress.}
    "\n\n"
    {You can ignore this entry under Windows.}
  }

aqinst_ask_yn .verbose \
  {Verbose:} \
  verbose \
  1 \
  {
    {If this is selected, then actions (such as making directories or }
    {copying files) will be written to standard output as they are }
    {performed.}
  }


if {[catch {package require Tk}]} {
  if {$auto} {
    aqinst_install_aqtools
    exit 0
  }
  
  puts ""
  set done 0
  while {! $done} {
    puts "Type `i' to install, or `c' to cancel without installing:"
    gets stdin action
    switch -glob -- $action {
      {[Ii]*} {
        aqinst_install_aqtools
        set done 1
      }
      {[Cc]*} {exit 0}
    }
  }
  exit 0
} else {
  pack [frame .topframe -height 5 -relief flat] -fill x
  pack .wish -fill x
  pack .bin -fill x
  pack .lib -fill x
  pack .installhtml -fill x
  pack .html -fill x
  pack .installtoys -fill x
  pack .toybin -fill x
  pack .tclsh -fill x
  pack .verbose -fill x
  pack [frame .bottomframe -height 5 -relief flat] -fill x
  pack [frame .rule -relief sunken -height 2 -borderwidth 1] -fill x
  
  ######################################################################
  
  frame .b
  button .b.install -text Install -width 8 -command aqinst_install_aqtools
  button .b.cancel -text Cancel -width 8 -command aqinst_cancel
  
  frame .b.spacer -width 5p
  pack .b.spacer -side right
  
  pack .b.install .b.cancel -side right -padx 5p -pady 10p
  pack .b -fill x
}
