###############################################################################
#
# pkgu.eagle --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
# Package Uploader Client
#
# Copyright (c) 2007-2012 by Joe Mistachkin.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: $
#
###############################################################################

#
# NOTE: Use our own namespace here because even though we do not directly
#       support namespaces ourselves, we do not want to pollute the global
#       namespace if this script actually ends up being evaluated in Tcl.
#
namespace eval ::PackageUploader {
  #
  # NOTE: This procedure sets up the default values for all configuration
  #       parameters used by the package uploader client.  If the force
  #       argument is non-zero, any existing values will be overwritten
  #       and set back to their default values.
  #
  proc setupUploadVars { force } {
    #
    # NOTE: This variable must exist and must be the fully qualified path
    #       of the directory containing this script.
    #
    variable pkgr_path

    if {![info exists pkgr_path]} then {
      error [appendArgs \
          "required namespace variable \"" [namespace current] \
          "::pkgr_path\" does not exist"]
    }

    #
    # NOTE: The project code for the Fossil repository.  This will be checked
    #       prior to staging or committing any files.
    #
    variable projectCode; # DEFAULT: 9ceada8dbb8678898e5b2c05386e73b3ff2c2dec

    if {$force || ![info exists projectCode]} then {
      set projectCode 9ceada8dbb8678898e5b2c05386e73b3ff2c2dec
    }

    #
    # NOTE: What is the fully qualified path to the directory containing
    #       package client toolset?
    #
    variable scriptDirectory; # DEFAULT: <scriptDir>

    if {$force || ![info exists scriptDirectory]} then {
      set scriptDirectory $pkgr_path
    }

    #
    # NOTE: This is the name of the executable file used to invoke Fossil,
    #       possibly without a file extension.
    #
    variable fossilFileNameOnly; # DEFAULT: <unset>

    if {$force || ![info exists fossilFileNameOnly]} then {
      if {[isWindows]} then {
        set fossilFileNameOnly fossil.exe
      } else {
        set fossilFileNameOnly fossil
      }
    }

    #
    # NOTE: The command to use when attempting to verify that Fossil is
    #       available for use.
    #
    variable fossilVersionCommand; # DEFAULT: fossil version

    if {$force || ![info exists fossilVersionCommand]} then {
      set fossilVersionCommand {{${fossilFileNameOnly}} version}
    }

    #
    # NOTE: The regular expression pattern used when attempting to verify
    #       that Fossil is installed.
    #
    variable fossilVersionPattern; # DEFAULT: {^This is fossil version [12]... }

    if {$force || ![info exists fossilVersionPattern]} then {
      set fossilVersionPattern {^This is fossil version [12]\.\d+ }
    }

    #
    # NOTE: The command to use when attempting to check for changes prior to
    #       staging files using Fossil.
    #
    variable fossilChangesCommand; # DEFAULT: fossil changes ...

    if {$force || ![info exists fossilChangesCommand]} then {
      set fossilChangesCommand \
          {{${fossilFileNameOnly}} changes --chdir {${directory}}}
    }

    #
    # NOTE: The regular expression pattern used when attempting to verify
    #       that the Fossil checkout has no changes staged.  Generally, this
    #       pattern should only match an empty string.
    #
    variable fossilChangesPattern; # DEFAULT: {^$}

    if {$force || ![info exists fossilChangesPattern]} then {
      set fossilChangesPattern {^$}
    }

    #
    # NOTE: The command to use when attempting to check the checkout status
    #       prior to staging files using Fossil.
    #
    variable fossilInfoCommand; # DEFAULT: fossil info ...

    if {$force || ![info exists fossilInfoCommand]} then {
      set fossilInfoCommand \
          {{${fossilFileNameOnly}} info --chdir {${directory}}}
    }

    #
    # NOTE: The regular expression pattern used when attempting to extract
    #       the current check-in identifier for the Fossil checkout.
    #
    variable fossilInfoCheckoutPattern; # DEFAULT: {^checkout:\s+... UTC$}

    if {$force || ![info exists fossilInfoCheckoutPattern]} then {
      set fossilInfoCheckoutPattern \
          {^checkout:\s+([0-9a-f]{40}) \d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2} UTC$}
    }

    #
    # NOTE: The regular expression pattern used when attempting to extract
    #       the root directory for the Fossil checkout.
    #
    variable fossilInfoLocalRootPattern; # DEFAULT: {^local-root:\s+(.*?)$}

    if {$force || ![info exists fossilInfoLocalRootPattern]} then {
      set fossilInfoLocalRootPattern {^local-root:\s+(.*?)$}
    }

    #
    # NOTE: The regular expression pattern used when attempting to verify
    #       that the Fossil checkout belongs to the correct project.
    #
    variable fossilInfoProjectCodePattern; # DEFAULT: {^project-code:\\s+...\$}

    if {$force || ![info exists fossilInfoProjectCodePattern]} then {
      set fossilInfoProjectCodePattern [appendArgs \
          {^project-code:\\s+${projectCode}\$}]
    }

    #
    # NOTE: The regular expression pattern used when attempting to verify
    #       that the Fossil checkout is sitting on the correct branch.
    #
    variable fossilInfoTagsPattern; # DEFAULT: {^tags:\s+trunk(?:,|$)}

    if {$force || ![info exists fossilInfoTagsPattern]} then {
      set fossilInfoTagsPattern {^tags:\s+trunk(?:,|$)}
    }

    #
    # NOTE: The command to use when attempting to reset the checkout to the
    #       default branch prior to staging files using Fossil.
    #
    variable fossilUpdateCommand; # DEFAULT: fossil update trunk ...

    if {$force || ![info exists fossilUpdateCommand]} then {
      set fossilUpdateCommand \
          {{${fossilFileNameOnly}} update trunk --chdir {${directory}}}
    }

    #
    # NOTE: The command to use when attempting to stage package files using
    #       Fossil.
    #
    variable fossilAddCommand; # DEFAULT: fossil add ...

    if {$force || ![info exists fossilAddCommand]} then {
      set fossilAddCommand \
          {{${fossilFileNameOnly}} add --chdir {${directory}} {${fileName}}}
    }

    #
    # NOTE: The command to use when attempting to commit package files using
    #       Fossil.
    #
    variable fossilCommitCommand; # DEFAULT: fossil commit ...

    if {$force || ![info exists fossilCommitCommand]} then {
      set fossilCommitCommand \
          {{${fossilFileNameOnly}} commit -m {${comment}}\
          --branch {${branch}} --user anonymous --chdir\
          {${directory}} --no-prompt}
    }

    #
    # NOTE: The regular expression pattern used when attempting to verify
    #       that Fossil committed a set of files.
    #
    variable fossilCommitPattern; # DEFAULT: {^New_Version: ([0-9a-f]{40,64})$}

    if {$force || ![info exists fossilCommitPattern]} then {
      set fossilCommitPattern {^New_Version: ([0-9a-f]{40,64})$}
    }

    #
    # NOTE: Emit diagnostic messages when a new package is submitted?
    #
    variable verboseMetadataSubmit; # DEFAULT: false

    if {$force || ![info exists verboseMetadataSubmit]} then {
      set verboseMetadataSubmit false
    }
  }

  #
  # NOTE: This procedure sets up the default values for all configuration
  #       parameters used by the package uploader client that require the
  #       location of the checkout directory.  If the force argument is
  #       non-zero, any existing values will be overwritten and set back
  #       to their default values.
  #
  proc setupCheckoutVars { force } {
    #
    # NOTE: What is the fully qualified path to the root directory of the
    #       Fossil checkout containing the package client toolset?  This
    #       procedure may raise script errors.
    #
    variable checkoutDirectory; # DEFAULT: <checkoutDir>

    if {$force || ![info exists checkoutDirectory]} then {
      set checkoutDirectory [getCheckoutDirectory]
    }
  }

  #
  # NOTE: This procedure returns a string value, formatted for use within a
  #       script block being processed by the [string map] command.  The
  #       value argument is the string value to format.  No return value is
  #       reserved to indicate an error.  This procedure may not raise any
  #       script errors.
  #
  proc formatStringMapValue { value } {
    if {[string length $value] == 0} then {
      return \"\"
    }

    set list [list $value]

    if {$value eq $list} then {
      return $value
    } else {
      return $list
    }
  }

  #
  # NOTE: This procedure counts the common path components for two paths.  The
  #       count is returned, zero if there are no common path components.  The
  #       path1 and path2 arguments are the paths to compare.  This procedure
  #       may not raise script errors.
  #
  proc countCommonPathParts { path1 path2 } {
    set parts1 [file split $path1]
    set length1 [llength $parts1]

    set parts2 [file split $path2]
    set length2 [llength $parts2]

    set length [expr {min($length1, $length2)}]

    for {set index 0} {$index < $length} {incr index} {
      set part1 [lindex $parts1 $index]
      set part2 [lindex $parts2 $index]

      if {$part1 ne $part2} then {
        return $index
      }
    }

    return $length
  }

  #
  # NOTE: This procedure processes a list of (fully?) qualified file names and
  #       tries to determine their common containing directory, if any.  The
  #       fileNames argument is the list of (fully?) qualified file names to
  #       process.  This procedure may not raise script errors.  If there is
  #       no common containing directory, an empty string is returned.
  #
  proc getCommonContainingDirectory { fileNames } {
    set length [llength $fileNames]

    if {$length == 0} then {
      return ""
    }

    set oldFileName [lindex $fileNames 0]

    if {$length == 1} then {
      return [file dirname $oldFileName]
    }

    set minimumCount 0

    for {set index 1} {$index < $length} {incr index} {
      set newFileName [lindex $fileNames $index]
      set newCount [countCommonPathParts $oldFileName $newFileName]

      if {$newCount == 0} then {
        return ""
      }

      if {$minimumCount == 0 || $newCount < $minimumCount} then {
        set oldFileName $newFileName
        set minimumCount $newCount
      }
    }

    if {$minimumCount == 0} then {
      return ""
    }

    incr minimumCount -1

    return [eval file join [lrange [file split $oldFileName] 0 $minimumCount]]
  }

  #
  # NOTE: This procedure attempts to process a list of (fully?) qualified file
  #       names and return the corresponding list of relative file names.  The
  #       fileNames argument is the list of (fully?) qualified file names to
  #       process.  The maximumLevels argument is the maximum path depth that
  #       is allowed for all file names.  This procedure may raise script
  #       errors.
  #
  proc getRelativeFileNames { fileNames maximumLevels } {
    set directory [getCommonContainingDirectory $fileNames]
    set directoryParts [file split $directory]
    set fileNameIndex [expr {[llength $directoryParts] - 1}]

    if {$fileNameIndex < 0} then {
      error [appendArgs \
          "invalid containing directory \"" $directory \
          "\": cannot go up one level"]
    }

    set relativeFileNames [list]

    foreach fileName $fileNames {
      set fileNameParts [lrange \
          [file split $fileName] $fileNameIndex end]

      if {$maximumLevels > 0 && \
          [llength $fileNameParts] > $maximumLevels} then {
        error [appendArgs \
            "depth for file name \"" $fileName \
            "\" exceeds maximum (" $maximumLevels )]
      }

      set relativeFileName [eval file join $fileNameParts]

      if {[string length $relativeFileName] == 0 || \
          [file pathtype $relativeFileName] ne "relative"} then {
        error [appendArgs \
            "bad file name \"" $relativeFileName "\", not relative"]
      }

      lappend relativeFileNames $relativeFileName
    }

    return $relativeFileNames
  }

  #
  # NOTE: This procedure attempts to create a script chunk that appends the
  #       specified list of file names to a list variable.  The fileNames
  #       argument is the list of (fully?) qualified file names to append to
  #       the list variable.  The maximumLevels argument is the maximum path
  #       depth that is allowed for all file names.  This procedure may raise
  #       script errors.
  #
  proc getScriptChunkForFileNames { fileNames maximumLevels } {
    set result ""
    set relativeFileNames [getRelativeFileNames $fileNames $maximumLevels]

    foreach relativeFileName $relativeFileNames {
      if {[string length $result] > 0} then {
        append result \n
      }

      append result {  lappend fileNames [file join }
      append result [file split $relativeFileName]
      append result \]
    }

    return $result
  }

  #
  # NOTE: This procedure creates and returns a script block designed for use
  #       with the package repository server in order to download and provide
  #       a package consisting of a set of files.  The serverId argument is
  #       the identifier for the specific server to use, if any.  The
  #       versionId argument is the identifier for the specific version to use,
  #       if any.  The language argument must be the literal string "eagle" or
  #       the literal string "tcl".  The version argument must be one of the
  #       literal strings "8.4", "8.5", "8.6", or "8.7" when the language is
  #       "tcl" -OR- the literal string "1.0" when the language is "eagle".
  #       The platform argument must be an empty string -OR- one of the literal
  #       strings "neutral", "win32-arm", "win32-x86", "win64-arm64",
  #       "win64-ia64", or "win64-x64".  The fileNames argument is the list of
  #       (fully?) qualified file names to be downloaded when the associated
  #       package is being provided.  The options argument is reserved for
  #       future use, it should be an empty list.
  #
  proc createRepositoryScript {
          serverId versionId language version platform fileNames options } {
    ::PackageRepository::verifyServerId $serverId
    ::PackageDownloader::verifyVersionId $versionId
    ::PackageDownloader::verifyLanguageAndVersion $language $version isClient

    if {$isClient} then {
      error "cannot create repository script for client"
    }

    #
    # HACK: Automatic detection of the platform must be disabled here, since
    #       the generated repository script may want it performed late-bound,
    #       i.e. within the generated script block itself.
    #
    if {[string length $platform] > 0} then {
      ::PackageDownloader::verifyPlatform $platform platform
    }

    set prologue ""

    if {[string length $serverId] > 0} then {
      append prologue "  ::PackageDownloader::useServerId " $serverId \n
    }

    if {[string length $versionId] > 0} then {
      append prologue "  ::PackageDownloader::useVersionId " $versionId \n
    }

    append prologue "  "

    return [string trim [string map [list \r\n \n \
        %language% [formatStringMapValue $language] \
        %version% [formatStringMapValue $version] \
        %platform% [formatStringMapValue $platform] \
        %prologue% $prologue %ns% ::PackageDownloader \
        %backslash% \\  %fileNames% \
        [getScriptChunkForFileNames $fileNames 2]] {
apply [list [list] {
  set fileNames [list]

%fileNames%

  set options [list %backslash%
      -persistent false -usePgp true -useAutoPath true]

  package require Eagle.Package.Downloader

%prologue%%ns%::resetCookieAndLoginSimple
  %ns%::downloadFiles %language% %version% %platform% $fileNames $options
  %ns%::logoutAndResetCookie
}]
    }]]
  }

  #
  # NOTE: This procedure creates textual data that conforms to the content
  #       type "multipart/form-data", per RFC 2388.  The boundary argument
  #       is a boundary value, as specified in section 4.1 of the RFC.  The
  #       request argument is the dictionary of name/value pairs to include
  #       in the form body.  This procedure may not raise script errors.
  #
  proc createMultipartFormData { boundary request } {
    set result ""

    foreach {name value} $request {
      append result -- $boundary \r\n
      append result "Content-Disposition: form-data; name=\""
      append result $name \"\r\n\r\n
      append result $value \r\n
    }

    if {[string length $result] > 0} then {
      append result -- $boundary --\r\n
    }

    if {[isEagle]} then {
      return [object create -alias String $result]
    } else {
      return $result
    }
  }

  #
  # NOTE: This procedure returns the full URI to use when submitting a new
  #       package to the package repository server.  There are no arguments.
  #       This procedure may raise script errors.
  #
  proc getSubmitUri {} {
    #
    # NOTE: Fetch the base URI for the package repository server.  If it
    #       is not available for some reason, just return an empty string
    #       to the caller (i.e. as we cannot do anything productive).
    #
    set baseUri [::PackageRepository::getSubmitBaseUri]

    if {[string length $baseUri] == 0} then {
      return ""
    }

    #
    # NOTE: Build the HTTP request URI and include the standard query
    #       parameters (with constant values) for this request type.
    #
    if {[isEagle]} then {
      return [appendArgs \
          $baseUri ?raw=1&method=submit]
    } else {
      package require http 2.0

      return [appendArgs \
          $baseUri ? [::http::formatQuery raw 1 method submit]]
    }
  }

  #
  # NOTE: This procedure attempts to submit the metadata for a new package to
  #       the package repository server.  Upon success, an empty string will
  #       be returned.  Upon failure, a script error will be raised.  The
  #       apiKey argument is the list of API keys to use.  The package argument
  #       is the name of the package.  The patchLevel argument is the specific
  #       patch level being submitted.  The language argument must be an empty
  #       string, "Tcl", or "Eagle".  If it is an empty string, the current
  #       language will be assumed.  The script argument is the script to be
  #       evaluated when the package needs to be provided.  The certificate
  #       argument is the certificate associated with the script, which may be
  #       an OpenPGP signature or a Harpy script certificate.
  #
  proc submitPackageMetadata {
          apiKey package patchLevel language script certificate } {
    variable verboseMetadataSubmit

    ::PackageDownloader::verifyPackageName $package
    ::PackageDownloader::verifyPackagePatchLevel $patchLevel

    #
    # NOTE: Fetch the submission URI for the package repository server.  If
    #       it is not available for some reason, raise a script error.
    #
    set uri [getSubmitUri]

    if {[string length $uri] == 0} then {
      error ""
    }

    if {[string length $language] == 0} then {
      set language [expr {[isEagle] ? "Eagle" : "Tcl"}]
    }

    ::PackageRepository::verifyMetadataLanguage $language

    if {[isEagle]} then {
      set boundary [string map \
          [list + "" / "" = ""] [base64 encode [expr {randstr(50)}]]]
    } else {
      set boundary [::PackageRepository::getUniqueSuffix]
    }

    set contentType [appendArgs \
        "multipart/form-data; boundary=" $boundary]

    set formData [createMultipartFormData $boundary \
        [list apiKey $apiKey package $package patchLevel \
        $patchLevel language $language script $script \
        certificate $certificate]]

    if {[isEagle]} then {
      if {![info exists ::eagle_platform(compileOptions)]} then {
        error "missing compile options from Eagle platform array"
      }

      if {[lsearch -exact -- \
          $::eagle_platform(compileOptions) TEST] == -1} then {
        error "cannot upload: library missing TEST compile-option"
      }

      if {[lsearch -exact -- \
          $::eagle_platform(compileOptions) NETWORK] == -1} then {
        error "cannot upload: library missing NETWORK compile-option"
      }

      if {![object invoke Eagle._Tests.Default \
          TestHasScriptNewWebClientCallback ""]} then {
        set error null

        set code [object invoke Eagle._Tests.Default \
            TestSetScriptNewWebClientCallback "" true true error]

        if {$code ne "Ok"} then {
          error [getStringFromObjectHandle $error]
        }
      }

      set script [object create String {
        if {[methodName ToString] eq "GetWebRequest"} then {
          webRequest ContentType $contentType
        }
      }]

      set data [uri upload \
          -timeouttype network -inline -raw -encoding identity \
          -webclientdata $script -data $formData $uri]
    } else {
      set options [list \
          -binary true -type $contentType -query $formData]

      set data [eval ::PackageRepository::getFileViaHttp \
          [list $uri] [list 20] [list stdout] [list \
          [expr {!$verboseMetadataSubmit}]] $options]
    }

    set code [::PackageRepository::getResponseCodeFromRawData $data]
    set result [::PackageRepository::getResponseResultFromRawData $data]

    if {[::PackageRepository::isResponseCodeOk $code]} then {
      return $result
    } else {
      error [appendArgs \
          "failed to submit package metadata: " $data]
    }
  }

  #
  # NOTE: This procedure attempts to query the identifier of the Fossil
  #       checkout.  There are no arguments.  An empty string is returned if
  #       the information cannot be determined.
  #
  proc getCheckoutId {} {
    variable fossilFileNameOnly
    variable fossilInfoCommand
    variable fossilInfoCheckoutPattern
    variable scriptDirectory

    fossilMustBeInstalled

    if {[isEagle]} then {
      set directory [::PackageRepository::formatExecArgument \
          $scriptDirectory]

      if {[catch {
        eval exec -nocarriagereturns -stdout output -stderr error \
            [subst $fossilInfoCommand]
      } result] == 0} then {
        set result [appendArgs $output $error]
      } else {
        return ""
      }
    } else {
      set directory $scriptDirectory

      if {[catch {
        eval exec [subst $fossilInfoCommand]
      } result]} then {
        return ""
      }
    }

    if {![info exists result] || ![regexp -line -- \
        $fossilInfoCheckoutPattern $result dummy match]} then {
      return ""
    }

    return [string range [string trim $match] 0 9]
  }

  #
  # NOTE: This procedure attempts to query the root directory of the Fossil
  #       checkout.  There are no arguments.  An empty string is returned if
  #       the information cannot be determined.
  #
  proc getCheckoutDirectory {} {
    variable fossilFileNameOnly
    variable fossilInfoCommand
    variable fossilInfoLocalRootPattern
    variable scriptDirectory

    fossilMustBeInstalled

    if {[isEagle]} then {
      set directory [::PackageRepository::formatExecArgument \
          $scriptDirectory]

      if {[catch {
        eval exec -nocarriagereturns -stdout output -stderr error \
            [subst $fossilInfoCommand]
      } result] == 0} then {
        set result [appendArgs $output $error]
      } else {
        return ""
      }
    } else {
      set directory $scriptDirectory

      if {[catch {
        eval exec [subst $fossilInfoCommand]
      } result]} then {
        return ""
      }
    }

    if {![info exists result] || ![regexp -line -- \
        $fossilInfoLocalRootPattern $result dummy match]} then {
      return ""
    }

    return [string trim $match]
  }

  #
  # NOTE: This procedure builds a native path using the specified parts and
  #       returns it.  All arguments are considered to be parts of the path.
  #
  proc joinPath { args } {
    return [file nativename [eval file join $args]]
  }

  #
  # NOTE: This procedure attempts to verify that the root directory of the
  #       Fossil checkout is present, valid, and is actually a directory.
  #       There are no arguments.  Script errors will be raised if any of
  #       the checks fail.
  #
  proc verifyCheckoutDirectory {} {
    variable checkoutDirectory

    #
    # NOTE: Setup example directory paths for use in the error message
    #       that may be produced by this procedure.  Since these values
    #       are specific to the platform, they are setup in advance.
    #       These values are NOT used to interact with the file system.
    #
    if {[isWindows]} then {
      set repositories C:/repositories
      set checkouts C:/checkouts
    } else {
      set repositories ~/repositories
      set checkouts ~/checkouts
    }

    set message [subst {
      The package client checkout directory has an issue:

        %error%

      Prior to running the package uploader client tool, Fossil must be
      installed -AND- the Package File Server repository must be cloned
      and opened, using commands very similar to the following:

        mkdir [joinPath ${repositories}]
        cd [joinPath ${repositories}]
        fossil clone https://your_login@tcl.pkg.management/pkgd pkgd.fossil
        mkdir [joinPath ${checkouts}]
        cd [joinPath ${checkouts}]
        fossil open [joinPath ${repositories} pkgd.fossil]

      After the above steps have been completed, package uploader client
      tool can be executed using a command very similar to the following:

        tclsh [joinPath ${checkouts} client 1.0 neutral pkgr_upload.eagle]
    }]

    if {![info exists checkoutDirectory]} then {
      error [string map [list \
          %error% "checkout directory is missing"] \
          $message]
    }

    if {[string length $checkoutDirectory] == 0} then {
      error [string map [list \
          %error% "checkout directory is invalid"] \
          $message]
    }

    if {![file isdirectory $checkoutDirectory]} then {
      error [string map [list %error% [appendArgs \
          "checkout directory \"" $checkoutDirectory \
          "\" is not really a directory"]] $message]
    }
  }

  #
  # NOTE: This procedure attempts to verify that an implementation of Fossil
  #       is installed locally.  There are no arguments.  Script errors are
  #       raised if any problems are found.  The return value is undefined.
  #
  proc fossilMustBeInstalled {} {
    variable fossilFileNameOnly
    variable fossilVersionCommand
    variable fossilVersionPattern

    set message {
      Cannot use Fossil: it does not appear to be installed.

      Fossil may be downloaded from "https://www.fossil-scm.org/"
      and then installed by copying the (single) Fossil binary to
      a directory that lies somewhere along the executable search
      path.

      Alternatively, it may be possible to install Fossil via the
      package management subsystem included with your operating
      system.
    }

    if {[isEagle]} then {
      if {[catch {
        eval exec -nocarriagereturns -stdout output -stderr error \
            [subst $fossilVersionCommand]
      } result] == 0} then {
        set result [appendArgs $output $error]
      } else {
        error $message
      }
    } else {
      if {[catch {
        eval exec [subst $fossilVersionCommand]
      } result]} then {
        error $message
      }
    }

    if {![info exists result] || \
        ![regexp -- $fossilVersionPattern $result]} then {
      error "cannot use Fossil: unknown or unsupported version"
    }
  }

  #
  # NOTE: This procedure attempts to verify that the checkout directory does
  #       not contain any (stray) changes.  There are no arguments.  Non-zero
  #       is returned if the verification is successful.
  #
  proc verifyThereAreNoChanges {} {
    variable checkoutDirectory
    variable fossilChangesCommand
    variable fossilChangesPattern
    variable fossilFileNameOnly

    fossilMustBeInstalled
    verifyCheckoutDirectory

    if {[isEagle]} then {
      set directory [::PackageRepository::formatExecArgument \
          $checkoutDirectory]

      if {[catch {
        eval exec -nocarriagereturns -stdout output -stderr error \
            [subst $fossilChangesCommand]
      } result] == 0} then {
        set result [appendArgs $output $error]
      } else {
        return false
      }
    } else {
      set directory $checkoutDirectory

      if {[catch {
        eval exec [subst $fossilChangesCommand]
      } result]} then {
        return false
      }
    }

    if {![info exists result] || \
        ![regexp -- $fossilChangesPattern $result]} then {
      return false
    }

    return true
  }

  #
  # NOTE: This procedure attempts to verify that the checkout directory does
  #       belong to the correct project.  There are no arguments.  Non-zero
  #       is returned if the verification is successful.
  #
  proc verifyThisIsTheCorrectProject {} {
    variable fossilFileNameOnly
    variable fossilInfoCommand
    variable fossilInfoProjectCodePattern
    variable projectCode
    variable scriptDirectory

    fossilMustBeInstalled

    if {[isEagle]} then {
      set directory [::PackageRepository::formatExecArgument \
          $scriptDirectory]

      if {[catch {
        eval exec -nocarriagereturns -stdout output -stderr error \
            [subst $fossilInfoCommand]
      } result] == 0} then {
        set result [appendArgs $output $error]
      } else {
        return false
      }
    } else {
      set directory $scriptDirectory

      if {[catch {
        eval exec [subst $fossilInfoCommand]
      } result]} then {
        return false
      }
    }

    if {![info exists result] || ![regexp -line -- \
        [subst $fossilInfoProjectCodePattern] $result]} then {
      return false
    }

    return true
  }

  #
  # NOTE: This procedure attempts to verify that the checkout directory does
  #       belong to the correct branch.  There are no arguments.  Non-zero
  #       is returned if the verification is successful.
  #
  proc verifyThisIsTheCorrectBranch {} {
    variable fossilFileNameOnly
    variable fossilInfoCommand
    variable fossilInfoTagsPattern
    variable scriptDirectory

    fossilMustBeInstalled

    if {[isEagle]} then {
      set directory [::PackageRepository::formatExecArgument \
          $scriptDirectory]

      if {[catch {
        eval exec -nocarriagereturns -stdout output -stderr error \
            [subst $fossilInfoCommand]
      } result] == 0} then {
        set result [appendArgs $output $error]
      } else {
        return false
      }
    } else {
      set directory $scriptDirectory

      if {[catch {
        eval exec [subst $fossilInfoCommand]
      } result]} then {
        return false
      }
    }

    if {![info exists result] || \
        ![regexp -line -- $fossilInfoTagsPattern $result]} then {
      return false
    }

    return true
  }

  #
  # NOTE: This procedure attempts to change the branch for the checkout
  #       directory.  There are no arguments.  This procedure may raise
  #       script errors.
  #
  proc changeToTheCorrectBranch {} {
    variable checkoutDirectory
    variable fossilFileNameOnly
    variable fossilUpdateCommand

    fossilMustBeInstalled
    verifyCheckoutDirectory

    if {[isEagle]} then {
      set directory [::PackageRepository::formatExecArgument \
          $checkoutDirectory]

      if {[catch {
        eval exec -success Success [subst $fossilUpdateCommand]
      } error]} then {
        error [appendArgs \
            "could not change branch: " $error]
      }
    } else {
      set directory $checkoutDirectory

      if {[catch {
        eval exec [subst $fossilUpdateCommand]
      } error]} then {
        error [appendArgs \
            "could not change branch: " $error]
      }
    }
  }

  #
  # NOTE: This procedure attempts to stage the specified package file using
  #       Fossil.  The targetDirectory argument is the fully qualified path
  #       to the package platform directory.  The fileName argument is the
  #       relative name of the file to be staged.  This procedure may raise
  #       script errors.
  #
  proc stageOnePackageFile { targetDirectory fileName } {
    variable fossilAddCommand
    variable fossilFileNameOnly

    fossilMustBeInstalled

    if {[isEagle]} then {
      set directory [::PackageRepository::formatExecArgument \
          $targetDirectory]

      set fileName [::PackageRepository::formatExecArgument $fileName]

      if {[catch {
        eval exec -success Success [subst $fossilAddCommand]
      } error]} then {
        error [appendArgs \
            "could not stage file \"" $fileName "\": " $error]
      }
    } else {
      set directory $targetDirectory

      if {[catch {
        eval exec [subst $fossilAddCommand]
      } error]} then {
        error [appendArgs \
            "could not stage file \"" $fileName "\": " $error]
      }
    }
  }

  #
  # NOTE: This procedure attempts to stage the specified package files using
  #       Fossil.  The fileNames argument is a list of (fully?) qualified
  #       local file names to stage.
  #
  proc stagePackageFiles { language version platform fileNames } {
    variable checkoutDirectory
    variable fossilAddCommand
    variable fossilFileNameOnly

    ::PackageDownloader::verifyLanguageAndVersion $language $version isClient

    if {$isClient} then {
      error "cannot stage package files for client"
    }

    ::PackageDownloader::verifyPlatform $platform platform
    verifyCheckoutDirectory

    if {![verifyThereAreNoChanges]} then {
      error "cannot stage files: there are pending changes"
    }

    if {![verifyThisIsTheCorrectProject]} then {
      error "cannot stage files: wrong project"
    }

    if {![verifyThisIsTheCorrectBranch]} then {
      changeToTheCorrectBranch

      if {![verifyThisIsTheCorrectBranch]} then {
        error "cannot stage files: still on wrong branch"
      }
    }

    set targetDirectory [file join \
        $checkoutDirectory packages $language $version $platform]

    set relativeFileNames [getRelativeFileNames $fileNames 2]

    foreach fileName $fileNames relativeFileName $relativeFileNames {
      file mkdir [file join \
          $targetDirectory [file dirname $relativeFileName]]

      set checkoutFileName [file join $targetDirectory $relativeFileName]

      file copy $fileName $checkoutFileName

      if {![::PackageRepository::createOpenPgpSignature \
          $checkoutFileName]} then {
        error [appendArgs \
            "could not stage file \"" $fileName \
            "\": OpenPGP signing failed"]
      }

      set checkoutFileExtension [file extension $checkoutFileName]

      if {$checkoutFileExtension eq ".eagle" || \
          $checkoutFileExtension eq ".eeagle"} then {
        if {![::PackageRepository::createHarpyCertificate \
            $checkoutFileName]} then {
          error [appendArgs \
              "could not stage file \"" $fileName \
              "\": Harpy signing failed"]
        }

        if {![::PackageRepository::createOpenPgpSignature \
            [appendArgs $checkoutFileName .harpy]]} then {
          error [appendArgs \
              "could not stage file \"" $fileName \
              ".harpy\": OpenPGP signing failed"]
        }

        stageOnePackageFile $targetDirectory [appendArgs \
            $relativeFileName .harpy]

        stageOnePackageFile $targetDirectory [appendArgs \
            $relativeFileName .harpy.asc]
      }

      stageOnePackageFile $targetDirectory $relativeFileName
      stageOnePackageFile $targetDirectory [appendArgs $relativeFileName .asc]
    }
  }

  #
  # NOTE: This procedure attempts to commit the staged package files to the
  #       remote package file repository using Fossil.  The varName argument
  #       is the name of a scalar variable in the context of the immediate
  #       caller that will receive the resulting Fossil check-in identifier.
  #
  proc commitPackageFiles { package patchLevel language version varName } {
    variable checkoutDirectory
    variable fossilCommitCommand
    variable fossilCommitPattern
    variable fossilFileNameOnly

    ::PackageDownloader::verifyPackageName $package
    ::PackageDownloader::verifyPackagePatchLevel $patchLevel

    ::PackageDownloader::verifyLanguageAndVersion \
        [string tolower $language] $version isClient

    if {$isClient} then {
      error "cannot commit package files for client"
    }

    fossilMustBeInstalled
    verifyCheckoutDirectory

    set branch [appendArgs pkg_ $package _ $patchLevel]

    set comment [appendArgs \
        "Add package " $package " v" $patchLevel " for " $language \
        " v" $version " using client \[" [getCheckoutId] \].]

    if {[isEagle]} then {
      set directory [::PackageRepository::formatExecArgument \
          $checkoutDirectory]

      set branch [::PackageRepository::formatExecArgument $branch]
      set comment [::PackageRepository::formatExecArgument $comment]

      if {[catch {
        eval exec -nocarriagereturns -stdout output -stderr error \
            [subst $fossilCommitCommand]
      } result] == 0} then {
        set result [appendArgs $output $error]
      } else {
        return false
      }
    } else {
      set directory $checkoutDirectory

      if {[catch {
        eval exec [subst $fossilCommitCommand]
      } result]} then {
        return false
      }
    }

    if {[string length $varName] > 0} then {
      upvar 1 $varName checkin
    }

    if {![info exists result] || \
        ![regexp -line -- $fossilCommitPattern $result dummy checkin]} then {
      return false
    }

    return true
  }

  #
  # NOTE: This procedure initializes the array containing data derived from
  #       the command line arguments, if any.  The argv argument should be
  #       the list of command line arguments.
  #
  # <internal>
  proc setupArgumentData { argv } {
    variable argumentData

    if {![info exists argumentData(serverId)]} then {
      set argumentData(serverId) ""
    }

    if {![info exists argumentData(apiKey)]} then {
      set argumentData(apiKey) ""
    }

    if {![info exists argumentData(package)]} then {
      set argumentData(package) ""
    }

    if {![info exists argumentData(patchLevel)]} then {
      set argumentData(patchLevel) ""
    }

    if {![info exists argumentData(language)]} then {
      set argumentData(language) ""
    }

    if {![info exists argumentData(version)]} then {
      set argumentData(version) ""
    }

    if {![info exists argumentData(platform)]} then {
      set argumentData(platform) ""
    }

    if {![info exists argumentData(fileNames)]} then {
      set argumentData(fileNames) [list]
    }

    if {[llength $argv] >= 1} then {
      set argumentData(serverId) [lindex $argv 0]
    }

    if {[llength $argv] >= 2} then {
      set argumentData(apiKey) [lindex $argv 1]
    }

    if {[llength $argv] >= 3} then {
      set argumentData(package) [lindex $argv 2]
    }

    if {[llength $argv] >= 4} then {
      set argumentData(patchLevel) [lindex $argv 3]
    }

    if {[llength $argv] >= 5} then {
      set argumentData(language) [lindex $argv 4]
    }

    if {[llength $argv] >= 6} then {
      set argumentData(version) [lindex $argv 5]
    }

    if {[llength $argv] >= 7} then {
      set argumentData(platform) [lindex $argv 6]
    }

    if {[llength $argv] >= 8} then {
      set argumentData(fileNames) [lrange $argv 7 end]
    }
  }

  #
  # NOTE: This procedure is used to determine if all the package submission
  #       data is available.  There are no arguments.  Non-zero is returned
  #       if all the package submission data is available.  This procedure
  #       should not raise script errors.
  #
  # <internal>
  proc haveArgumentData {} {
    variable argumentData

    if {![info exists argumentData(serverId)]} then {
      return false
    }

    #
    # NOTE: *HACK* Actually, this *is* allowed.  It means that the
    #       default server is being used.
    #
    # if {[string length $argumentData(serverId)] == 0} then {
    #   return false
    # }

    if {![info exists argumentData(apiKey)]} then {
      return false
    }

    if {[string length $argumentData(apiKey)] == 0} then {
      return false
    }

    if {![info exists argumentData(package)]} then {
      return false
    }

    if {[string length $argumentData(package)] == 0} then {
      return false
    }

    if {![info exists argumentData(patchLevel)]} then {
      return false
    }

    if {[string length $argumentData(patchLevel)] == 0} then {
      return false
    }

    if {![info exists argumentData(language)]} then {
      return false
    }

    if {[string length $argumentData(language)] == 0} then {
      return false
    }

    if {![info exists argumentData(version)]} then {
      return false
    }

    if {[string length $argumentData(version)] == 0} then {
      return false
    }

    if {![info exists argumentData(platform)]} then {
      return false
    }

    if {[string length $argumentData(platform)] == 0} then {
      return false
    }

    if {![info exists argumentData(fileNames)]} then {
      return false
    }

    if {[llength $argumentData(fileNames)] == 0} then {
      return false
    }

    return true
  }

  #
  # NOTE: This procedure is an event handler.  It handles the Changed event
  #       for a text box.  It is not used when the user interface was built
  #       with Tk.  The varName argument is the name of the scalar variable
  #       that must be updated with the contents of the text box.  The sender
  #       and e arguments are provided by the framework and represent the
  #       control involved in the event and any extra data that may be
  #       necessary to process the event.
  #
  proc textBoxEventHandler { varName sender e } {
    set $varName [$sender Text]
  }

  #
  # NOTE: This procedure is an event handler.  It handles double-clicking the
  #       list box in both Tk and Eagle.  The varName argument is the name of
  #       the scalar variable that must be updated with the list of items from
  #       the list box -OR- the list of items from an interactive file picker
  #       dialog.  The args argument, which is only used for Eagle, is a list
  #       containing two elements.  The first element is the control involved
  #       in the event.  The second element is any extra data that may be
  #       necessary to process the event.
  #
  proc listBoxEventHandler { varName args } {
    if {[isEagle]} then {
      set sender [lindex $args 0]
      set e [lindex $args 1]

      set dialog [object create -alias OpenFileDialog]

      $dialog RestoreDirectory true
      $dialog Multiselect true
      $dialog ShowDialog

      set fileNames [$dialog -create FileNames]

      $sender Items.Clear
      $sender Items.AddRange $fileNames

      set list [object create -alias StringList $fileNames]

      set $varName [$list ToString]
    } else {
      set $varName [tk_getOpenFile -multiple true]
    }
  }

  #
  # NOTE: This procedure is an event handler.  It handles the Closed event for
  #       a WinForms form -OR- the WM_DELETE_WINDOW event on a Tk window.  The
  #       args argument is not really used, it is a placeholder to make this
  #       procedure more portable between Tcl and Eagle.  This procedure may
  #       raise script errors.
  #
  proc handleFormClosedEvent { args } {
    if {[isEagle]} then {
      set sender [lindex $args 0]; # NOTE: Disposal.
      set e [lindex $args 1]; # NOTE: Disposal.
    } else {
      variable widgets; destroy $widgets(toplevel)
    }

    #
    # NOTE: Terminate the [vwait].
    #
    set [appendArgs [namespace current] ::forever] 1
  }

  #
  # NOTE: This procedure is an event handler.  It handles the submit button in
  #       both Tk and Eagle.  It starts the package submission process.  The
  #       args argument is not really used, it is a placeholder to make this
  #       procedure more portable between Tcl and Eagle.  This procedure may
  #       raise script errors.
  #
  # <internal>
  proc submitEventHandler { args } {
    variable argumentData

    set batchMode [lindex $args 0]

    if {[isEagle]} then {
      set sender [lindex $args 1]; # NOTE: Disposal.
      set e [lindex $args 2]; # NOTE: Disposal.
    }

    if {[haveArgumentData]} then {
      set serverId $argumentData(serverId)
      set apiKey $argumentData(apiKey)
      set package $argumentData(package)
      set patchLevel $argumentData(patchLevel)
      set language $argumentData(language)
      set version $argumentData(version)
      set platform $argumentData(platform)
      set fileNames $argumentData(fileNames)

      ::PackageRepository::probeForOpenPgpInstallation
      ::PackageRepository::openPgpMustBeInstalled

      if {1} then {
        stagePackageFiles \
            [string tolower $language] $version $platform $fileNames

        if {![commitPackageFiles \
            $package $patchLevel [string totitle $language] $version \
            checkin]} then {
          error "failed to commit package files"
        }

        #
        # TODO: Is this the best heuristic here for figuring out that the
        #       platform should really be "automatic" in the repository?
        #
        if {$platform eq "neutral" || \
            $platform eq [::PackageDownloader::getPlatform]} then {
          set scriptPlatform ""
        } else {
          set scriptPlatform $platform
        }

        set script [createRepositoryScript \
            $serverId $checkin [string tolower $language] $version \
            $scriptPlatform $fileNames [list]]

        set scriptFileName [file join \
            [::PackageRepository::getFileTempDirectory PKGR_UPLOAD_TEMP] \
            [appendArgs pkgr_upload_ [::PackageRepository::getUniqueSuffix]]]

        writeFile $scriptFileName $script

        if {![::PackageRepository::createOpenPgpSignature \
            $scriptFileName]} then {
          error [appendArgs \
              "cannot submit package metadata: OpenPGP signing of \"" \
              $scriptFileName "\" failed"]
        }

        set certificate [readFile [appendArgs $scriptFileName .asc]]

        set result [submitPackageMetadata \
            $apiKey $package $patchLevel [string totitle $language] \
            $script $certificate]

        if {!$batchMode} then {
          set title [appendArgs \
              "Package Uploader Client: " [lindex [info level 0] 0]]

          if {[string length $result] > 0} then {
            set message [appendArgs \
                "Package was submitted successfully: " $result]
          } else {
            set message "Package was submitted successfully."
          }

          if {[isEagle]} then {
            catch {
              object invoke MessageBox Show $message $title
            }
          } else {
            catch {
              tk_messageBox -type ok -message $message -title $title
            }
          }
        }
      }
    } else {
      error "cannot initiate package submission: one or more fields missing"
    }
  }

  #
  # NOTE: This procedure is an event handler.  It handles the clear button in
  #       Tk and Eagle.  It is used to clear the package submission data.  The
  #       args argument is not really used, it is a placeholder to make this
  #       procedure more portable between Tcl and Eagle.  This procedure may
  #       raise script errors.
  #
  proc clearEventHandler { args } {
    variable argumentData

    if {[isEagle]} then {
      set sender [lindex $args 0]; # NOTE: Disposal.
      set e [lindex $args 1]; # NOTE: Disposal.

      variable widgets

      $widgets(2) Text ""
      $widgets(4) Text ""
      $widgets(6) Text ""
      $widgets(8) Text ""
      $widgets(10) Text ""
      $widgets(12) Text ""
      $widgets(14) Text ""
      $widgets(16) Items.Clear
    } else {
      set argumentData(serverId) ""
      set argumentData(apiKey) ""
      set argumentData(package) ""
      set argumentData(patchLevel) ""
      set argumentData(language) ""
      set argumentData(version) ""
      set argumentData(platform) ""
    }

    #
    # NOTE: This is done for Tk because it will also clear the on-screen
    #       widget itself.  For Eagle, this is necessary because there is
    #       no "listvariable" option and clearing the on-screen widget has
    #       no impact on the underyling list.
    #
    set argumentData(fileNames) [list]
  }

  #
  # NOTE: This procedure creates the user interface for this tool using Eagle
  #       and WinForms.  The existing argument data, if any, will be used to
  #       populate it.  There are no arguments.
  #
  # <internal>
  proc setupWinFormsUserInterface {} {
    variable argumentData
    variable widgets

    object load -import System.Windows.Forms

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

    set form [object create -alias Form]
    set widgets(0) $form

    $form Text "Package Uploader Client"
    $form MaximizeBox false
    $form AutoSize true
    $form add_Closed [namespace code [list handleFormClosedEvent]]

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

    set widgets(1) [object create -alias Label]
    $widgets(1) Name lblServerId
    $widgets(1) Text "Server ID (normally blank)"

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

    set widgets(2) [object create -alias TextBox]

    $widgets(2) Name txtServerId
    $widgets(2) Text $argumentData(serverId)

    $widgets(2) add_TextChanged [namespace code \
        [list textBoxEventHandler [appendArgs [namespace current] \
        ::argumentData(serverId)]]]

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

    set widgets(3) [object create -alias Label]
    $widgets(3) Name lblApiKey
    $widgets(3) Text "API Key (40 hexadecimal digits)"

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

    set widgets(4) [object create -alias TextBox]

    $widgets(4) Name txtApiKey
    $widgets(4) Text $argumentData(apiKey)

    $widgets(4) add_TextChanged [namespace code \
        [list textBoxEventHandler [appendArgs [namespace current] \
        ::argumentData(apiKey)]]]

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

    set widgets(5) [object create -alias Label]
    $widgets(5) Name lblPackage
    $widgets(5) Text "Package Name"

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

    set widgets(6) [object create -alias TextBox]

    $widgets(6) Name txtPackage
    $widgets(6) Text $argumentData(package)

    $widgets(6) add_TextChanged [namespace code \
        [list textBoxEventHandler [appendArgs [namespace current] \
        ::argumentData(package)]]]

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

    set widgets(7) [object create -alias Label]
    $widgets(7) Name lblPatchLevel
    $widgets(7) Text "Package Patch Level"

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

    set widgets(8) [object create -alias TextBox]

    $widgets(8) Name txtPatchLevel
    $widgets(8) Text $argumentData(patchLevel)

    $widgets(8) add_TextChanged [namespace code \
        [list textBoxEventHandler [appendArgs [namespace current] \
        ::argumentData(patchLevel)]]]

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

    set widgets(9) [object create -alias Label]
    $widgets(9) Name lblLanguage
    $widgets(9) Text Language

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

    set widgets(10) [object create -alias TextBox]

    $widgets(10) Name txtLanguage
    $widgets(10) Text $argumentData(language)

    $widgets(10) add_TextChanged [namespace code \
        [list textBoxEventHandler [appendArgs [namespace current] \
        ::argumentData(language)]]]

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

    set widgets(11) [object create -alias Label]
    $widgets(11) Name lblVersion
    $widgets(11) Text Version

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

    set widgets(12) [object create -alias TextBox]

    $widgets(12) Name txtVersion
    $widgets(12) Text $argumentData(version)

    $widgets(12) add_TextChanged [namespace code \
        [list textBoxEventHandler [appendArgs [namespace current] \
        ::argumentData(version)]]]

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

    set widgets(13) [object create -alias Label]
    $widgets(13) Name lblPlatform
    $widgets(13) Text Platform

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

    set widgets(14) [object create -alias TextBox]

    $widgets(14) Name txtPlatform
    $widgets(14) Text $argumentData(platform)

    $widgets(14) add_TextChanged [namespace code \
        [list textBoxEventHandler [appendArgs [namespace current] \
        ::argumentData(platform)]]]

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

    set widgets(15) [object create -alias Label]
    $widgets(15) Name lblFileNames
    $widgets(15) Text Files

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

    set widgets(16) [object create -alias ListBox]
    $widgets(16) Name lstFileNames

    $widgets(16) add_DoubleClick [namespace code \
        [list listBoxEventHandler [appendArgs [namespace current] \
        ::argumentData(fileNames)]]]

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

    set widgets(17) [object create -alias Button]
    $widgets(17) Name btnSubmit
    $widgets(17) Text Submit
    $widgets(17) add_Click [namespace code [list submitEventHandler false]]

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

    set widgets(18) [object create -alias Button]
    $widgets(18) Name btnClear
    $widgets(18) Text Clear
    $widgets(18) add_Click [namespace code [list clearEventHandler]]

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

    set horizontalMargin \
        [expr {([$form Width] - [$form ClientSize.Width]) / 2}]

    set verticalMargin \
        [expr {([$form Height] - [$form ClientSize.Height]) / 2}]

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

    set top $verticalMargin

    foreach name [lsort -integer [array names widgets]] {
      if {$name eq "0"} then continue

      $widgets($name) Width [expr {
        [$form ClientSize.Width] - ($horizontalMargin * 2)
      }]

      $widgets($name) Left $horizontalMargin
      $widgets($name) Top $top
      $form Controls.Add $widgets($name)

      incr top [$widgets($name) Height]
      incr top $verticalMargin
    }

    $form Show

    after 0 [list nop]; # NOTE: Needed for the [vwait].
  }

  #
  # NOTE: This procedure creates the user interface for this tool using Tcl
  #       and Tk.  The existing argument data, if any, will be used to
  #       populate it.  There are no arguments.
  #
  # <internal>
  proc setupTkUserInterface {} {
    variable widgets

    package require Tk
    catch {console show}
    catch {wm withdraw .}

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

    set toplevel [toplevel .uploader]
    set widgets(toplevel) $toplevel

    wm title $toplevel "Package Uploader Client"
    wm minsize $toplevel 250 0

    wm protocol $toplevel WM_DELETE_WINDOW \
        [namespace code [list handleFormClosedEvent]]

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

    set widgets(label,serverId) [label [appendArgs \
        $toplevel .la_serverId] -text "Server ID (normally blank)"]

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

    set widgets(entry,serverId) [entry [appendArgs \
        $toplevel .e_serverId] -textvariable [appendArgs \
        [namespace current] ::argumentData(serverId)]]

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

    set widgets(label,apiKey) [label [appendArgs \
        $toplevel .la_apiKey] -text "API Key (40 hexadecimal digits)"]

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

    set widgets(entry,apiKey) [entry [appendArgs \
        $toplevel .e_apiKey] -textvariable [appendArgs \
        [namespace current] ::argumentData(apiKey)]]

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

    set widgets(label,package) [label [appendArgs \
        $toplevel .la_package] -text "Package Name"]

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

    set widgets(entry,package) [entry [appendArgs \
        $toplevel .e_package] -textvariable [appendArgs \
        [namespace current] ::argumentData(package)]]

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

    set widgets(label,patchLevel) [label [appendArgs \
        $toplevel .la_patchLevel] -text "Package Patch Level"]

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

    set widgets(entry,patchLevel) [entry [appendArgs \
        $toplevel .e_patchLevel] -textvariable [appendArgs \
        [namespace current] ::argumentData(patchLevel)]]

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

    set widgets(label,language) [label [appendArgs \
        $toplevel .la_language] -text Language]

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

    set widgets(entry,language) [entry [appendArgs \
        $toplevel .e_language] -textvariable [appendArgs \
        [namespace current] ::argumentData(language)]]

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

    set widgets(label,version) [label [appendArgs \
        $toplevel .la_version] -text Version]

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

    set widgets(entry,version) [entry [appendArgs \
        $toplevel .e_version] -textvariable [appendArgs \
        [namespace current] ::argumentData(version)]]

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

    set widgets(label,platform) [label [appendArgs \
        $toplevel .la_platform] -text Platform]

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

    set widgets(entry,platform) [entry [appendArgs \
        $toplevel .e_platform] -textvariable [appendArgs \
        [namespace current] ::argumentData(platform)]]

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

    set widgets(label,fileNames) [label [appendArgs \
        $toplevel .la_fileNames] -text Files]

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

    set widgets(listbox,fileNames) [listbox [appendArgs \
        $toplevel .li_fileNames] -listvariable [appendArgs \
        [namespace current] ::argumentData(fileNames)]]

    bind $widgets(listbox,fileNames) <Double-Button-1> \
        [namespace code [list listBoxEventHandler [appendArgs \
        [namespace current] ::argumentData(fileNames)]]]

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

    set widgets(button,submit) [button \
        [appendArgs $toplevel .b_submit] -text Submit -command \
        [namespace code [list submitEventHandler false]]]

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

    set widgets(button,clear) [button \
        [appendArgs $toplevel .b_clear] -text Clear -command \
        [namespace code [list clearEventHandler]]]

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

    pack $widgets(label,serverId) $widgets(entry,serverId) \
        $widgets(label,apiKey) $widgets(entry,apiKey) \
        $widgets(label,package) $widgets(entry,package) \
        $widgets(label,patchLevel) $widgets(entry,patchLevel) \
        $widgets(label,language) $widgets(entry,language) \
        $widgets(label,version) $widgets(entry,version) \
        $widgets(label,platform) $widgets(entry,platform) \
        $widgets(label,fileNames) $widgets(listbox,fileNames) \
        $widgets(button,submit) $widgets(button,clear) \
        -expand true -fill both

    pack $widgets(button,submit) $widgets(button,clear) \
        -anchor e -expand false -fill none
  }

  #
  # NOTE: This package requires both the package repository and downloader
  #       client packages.
  #
  package require Eagle.Package.Repository
  package require Eagle.Package.Downloader

  #
  # NOTE: This package requires that support for namespaces, which is an
  #       optional feature of Eagle, must be enabled.
  #
  if {[isEagle] && ![namespace enable]} then {
    error "namespaces must be enabled for this package"
  }

  #
  # NOTE: Attempt to read optional settings file now.  This may override
  #       one or more of the variable setup in the next step.
  #
  ::PackageRepository::maybeReadSettingsFiles [info script]

  #
  # NOTE: Setup the variables, within this namespace, used by this package.
  #
  setupUploadVars false
  setupCheckoutVars false

  #
  # NOTE: Provide the package to the interpreter.
  #
  package provide Eagle.Package.Uploader 1.0.11
}
