Manpower

    #set up menu
    menu .mb

    #apple menu
    menu .mb.apple
    .mb.apple add command -label "About Manpower" -command tkAboutDialog
    .mb.apple add command -label "License" -command regproc::getReg
    .mb.apple add command -label "Check for Updates" -command "softwareupdate::checkVersion $appname::name $appname::version"
    .mb.apple add separator
    .mb add cascade -label "Manpower" -menu .mb.apple


    #man page menu
    menu .mb.man

    after 50

    .middle.left.tree selection set All
    set mynode All
    set searchterm {}
    set manitem {}

    after 500 
    regproc::readLic $appname::name $appname::version
    
}

proc changeImagesDark {} {

    foreach item [image names]  {
	if {[image type $item] eq "bitmap"} {

    } else {
	event generate . <<LightAqua>>
    }
}

#handle program shutdown via command-q
proc  ::tk::mac::Quit {} {
    exit
}


#command for services menu
proc ::tk::mac::PerformService {} {

    global manitem

package provide manpower 6.6

source [file join [file dirname [info script]] manpower-main.tcl]

  package ifneeded manpower 6.6 [list source [file join $dir manpower.tcl]]

# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

package ifneeded regproc 1.5 [list source [file join $dir regproc.tcl]]

#regproc.tcl  routines to register serial numbers

#Copyright 2015 WordTech Communications LLC

#MIT license

package provide regproc 1.5
package require http
package require xplat


image create bitmap _unlock -data  {
 
#define xbm_security_closed_32_width 32
#define xbm_security_closed_32_height 32

	variable library [file dirname [info script]]
    }
    variable datadir
    variable expired
    set expired 0


    #set the 30-day clock for application/version
    proc setClock {} {
	variable datadir 
	variable appname
	variable appversion
	variable appstore
	puts "datadir is $datadir"

	set launchTime [clock seconds]
	set saveTime [open $datadir/$appname$appversion.dat w]
	puts $saveTime $launchTime
	close $saveTime
    }

    #read the time set
    proc readClock {} {
	variable datadir 
	variable appstatus 
	variable expstatus 
	variable appname
	variable appversion
	variable appstore
	variable expired

	set curTime [clock seconds]
	set oldTime [read [open $datadir/$appname$appversion.dat r]]
	set expDate [clock scan "30 days" -base $oldTime]
	if {$curTime < $expDate } {
	    set expired 0
	    regproc::makePitch	
	} else {
	    set expired 1
	    regproc::expiredPitch
	}
    }
    
    #check to see if a time has been set
    proc checkClock {} {
	variable datadir 
	variable appname
	variable appversion
	variable appstore
	variable expired

	if {[file exists $datadir/.$appname$appversion.rc]} {
	    
	    catch "file rename $datadir/.$appname$appversion.rc $datadir/$appname$appversion.dat"
	    regproc::readClock
	    return
	}

	if  {![file exists  $datadir/$appname$appversion.dat]} {
	    regproc::setClock 
	    regproc::readClock
	} else {
	    regproc::readClock
	}
    }

    #dialog before demo has expired
    proc makePitch {} {
	variable version 
	variable appname
	variable appstore
	variable licensetitle
	set licensetitle "Purchase $appname"

	toplevel .purchase
	regproc::makeModal .purchase
	wm title .purchase $licensetitle
	wm resizable .purchase 0 0

	wm withdraw .purchase
	wm transient .purchase .

	wm protocol .purchase WM_DELETE_WINDOW {}

	ttk::frame .purchase.top -padding 10
	pack .purchase.top -side top -fill both -expand yes
	ttk::label .purchase.top.label -text "You are currently using a demo of $appname. This version will give you the chance to try \n$appname free of charge for 30 days. Would you like to buy $appname now?" -image _unlock -compound left -anchor n 

	pack .purchase.top.label  -side top -fill x -expand yes

	ttk::frame .purchase.bottom -padding 5
	pack .purchase.bottom -side bottom -fill both -expand yes

	ttk::frame .purchase.bottom.upper
	pack .purchase.bottom.upper -side top -fill both -expand no


	ttk::frame .purchase.bottom.lower -padding 5
	pack .purchase.bottom.lower -side bottom -fill both -expand no

	ttk::button .purchase.bottom.lower.install -text "Purchase" -default active -command "xplat::launch  http://www.codebykevin.com/$appname.html; regproc::getReg; destroy .purchase"
	ttk::button .purchase.bottom.lower.cancel -text "Cancel" -command " destroy .purchase; raise ."
	pack  .purchase.bottom.lower.install .purchase.bottom.lower.cancel  -side right -fill both -expand no
	
	::tk::PlaceWindow .purchase widget .

	wm deiconify .purchase
	focus .purchase.bottom.lower.install

	if {[tk windowingsystem] eq "aqua"} {
	    after idle [list after 0 wm attributes .purchase -notify 1]

	    bind all <FocusIn> [list  wm attributes . -notify 0]
	}

    }

    #dialog after demo has expired
    proc expiredPitch {} {
	variable version 
	variable appname
	variable appstore
	variable expired
	variable licensetitle

	set licensetitle "Purchase $appname"

	toplevel .expired
	regproc::makeModal .expired
	wm title .expired $licensetitle
	wm resizable .expired 0 0



	wm withdraw .expired
	wm transient .expired .

	wm protocol .expired WM_DELETE_WINDOW {}

	ttk::frame .expired.top -padding 10
	pack .expired.top -side top -fill both -expand yes
	ttk::label .expired.top.label -text "This demo of $appname is now expired. Would you like to buy $appname now?" -image _unlock -compound left -anchor n 

	pack .expired.top.label  -side top -fill x -expand yes

	ttk::frame .expired.bottom -padding 5
	pack .expired.bottom -side bottom -fill both -expand yes

	ttk::frame .expired.bottom.upper
	pack .expired.bottom.upper -side top -fill both -expand no


	ttk::frame .expired.bottom.lower -padding 5
	pack .expired.bottom.lower -side bottom -fill both -expand no

	ttk::button .expired.bottom.lower.install -text "Purchase" -default active -command "xplat::launch http://www.codebykevin.com/$appname.html; regproc::getReg; destroy .expired"
	ttk::button .expired.bottom.lower.cancel -text "Cancel" -command " destroy .expired; exit"
	pack  .expired.bottom.lower.install .expired.bottom.lower.cancel  -side right -fill both -expand no
	
	::tk::PlaceWindow .expired widget .

	wm deiconify .expired
	focus .expired.bottom.lower.install

	if {[tk windowingsystem] eq "aqua"} {
	    after idle [list after 0 wm attributes .expired -notify 1]

	    bind all <FocusIn> [list  wm attributes . -notify 0]
	}
    }

    #check for license, validate if found, set demo pitch if not found
    proc readLic {application version} {

	variable serial 
	variable datadir
	variable appname
	variable appversion
	variable appstore

	set appname $application
	set appversion $version

	set datadir [xplat::appconfig $appname]

	if {[file exists $datadir/.lic] } {
	    file rename $datadir/.lic $datadir/lic.dat
	}

	if {[file exists $datadir/lic.dat]} {
	    
	    set licnum [open $datadir/lic.dat r]
	    set serial [read $licnum]
	    close $licnum
	    return
	} else {
	    set serial "Demo"
	    regproc::checkClock
	    
	}
    }


    #write license to file
    proc setLic {} {
	variable serial
	variable serialbase
	variable datadir
	variable appname
	variable regwindow
	variable appstore
	variable expired

	if {$serial == ""} {
	    tk_messageBox -icon warning -title "Incorrect Serial Number" -message "Incorrect Serial Number" -detail "Incorrect serial number. The application will exit now." -parent .number
	    exit
	}

	set count 20000

	for {set i 1} {$i < $count} {incr i 1} {

	    lappend serialbase [string toupper $appname]-[expr $i * 5]-[expr $i/11]-[expr $i - 1]-[string toupper [string trim [string range $appname 0 1]]]
	}
	

	set output [lsearch  -inline $serialbase $serial]
	puts $serial
	puts $output
	
	if {$output >= 0} {
	    cd $datadir
	    set lic [open $datadir/lic.dat w]
	    puts $lic "$serial"
	    close $lic
		grab release .number
	    tk_messageBox -icon info -title "Thank You" -message "Thank You" -detail "Thank you for registering $appname." -parent .number
	    destroy .number
	    #display window that was hidden
	    catch {wm deiconify .}

	} else {
	    if {$expired == 1} {
		grab release .number
		tk_messageBox -icon warning -title "Incorrect Serial Number" -message "Incorrect Serial Number" -detail "Incorrect serial number. The application will exit now." -parent .number
		exit
	    }
	    grab release .number
	    tk_messageBox -icon warning -title "Incorrect Serial Number" -message "Incorrect Serial Number" -detail "Incorrect serial number. Please try again." -parent .number
	    regproc::getReg
	}
    }



    #generate license numbers
    proc genList {application} {

	variable appname
	variable regwindow
	variable appstore

	set appname $application

	set count 20000

	for {set i 1} {$i < $count} {incr i 1} {

	    lappend serialbase [string toupper $appname]-[expr $i * 5]-[expr $i/11]-[expr $i - 1]-[string toupper [string trim [string range $appname 0 1]]]
	}


	if [file exists  $::env(HOME)/[list $appname]-list] {
	    file delete  $::env(HOME)/[list $appname]-list
	}

	foreach item $serialbase {
	    split $item\n
	    set keylist [open $::env(HOME)/[list $appname]-list a]
	    puts $keylist $item
	    close $keylist
	}
    }

    #dialog to input registration number from demo prompt
    proc getReg {} {


	variable serial
	variable regwindow
	variable appstore
	variable expired
	variable appname
	variable licensetitle

	set licensetitle "License" 

	catch {destroy .number}
	toplevel .number
	wm title .number $licensetitle
	regproc::makeModal .number
	wm resizable .number 0 0

	wm withdraw .number
	wm transient .number .
    

	wm protocol .number WM_DELETE_WINDOW {}

	ttk::frame .number.top -padding 10
	pack .number.top -side top -fill both -expand yes

	
	ttk::label .number.top.label -text "Please enter your serial number for $appname\nin the field below:" -image _check -compound left -anchor n -padding 10
	pack .number.top.label -side top -fill both -expand yes

	ttk::entry .number.top.entry -textvariable [namespace current]::serial
	pack .number.top.entry -side bottom -fill both -expand yes

	ttk::frame .number.bottom -padding 5
	pack .number.bottom -side bottom -fill both -expand yes

	ttk::frame .number.bottom.upper
	pack .number.bottom.upper -side top -fill both -expand no


	ttk::frame .number.bottom.lower -padding 5
	pack .number.bottom.lower -side bottom -fill both -expand no

	bind .number <Return> {grab release .number; regproc::setLic;  raise .}
	ttk::button .number.bottom.lower.install -text "Register" -default active -command {grab release .number; regproc::setLic; raise .}
	ttk::button .number.bottom.lower.cancel -text "Cancel" -command "grab release .number; regproc::exitIfExpired; destroy .number; raise ."
	pack  .number.bottom.lower.install .number.bottom.lower.cancel  -side right -fill both -expand no
	
	::tk::PlaceWindow .number widget .

	wm deiconify .number
	focus .number.bottom.lower.install
	if {[tk windowingsystem] eq "aqua"} {
	    after idle [list after 0 wm attributes .number -notify 1]
	    bind all <FocusIn>  [list  wm attributes . -notify 0]
	}
    }

    proc exitIfExpired {} {

	variable expired
	if {$expired == 1} {
	    exit
	} 

    }

    proc makeModal {w} {

	variable licensetitle
	if {[tk windowingsystem] eq "aqua" } {
	    destroy $w; toplevel $w;  tk::unsupported::MacWindowStyle style $w  modal; wm title $w $licensetitle
	}
	if {[tk windowingsystem] eq "win32"} {

package ifneeded tls 1.6.7     "[list source [file join $dir tls.tcl]] ;      [list tls::initlib $dir libtls1.6.7.dylib]"

#
# Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com> 
#
# $Header: /cvsroot/tls/tls/tls.tcl,v 1.14 2015/07/07 17:16:03 andreas_kupries Exp $
#
namespace eval tls {
    variable logcmd tclLog
    variable debug 0
 
    # Default flags passed to tls::import
    variable defaults {}

    # Maps UID to Server Socket
    variable srvmap
    variable srvuid 0

    # Over-ride this if you are using a different socket command
    variable socketCmd
    if {![info exists socketCmd]} {
        set socketCmd [info command ::socket]
    }
}

proc tls::initlib {dir dll} {
    # Package index cd's into the package directory for loading.
    # Irrelevant to unixoids, but for Windows this enables the OS to find
    # the dependent DLL's in the CWD, where they may be.
    set cwd [pwd]
    catch {cd $dir}
    if {[string equal $::tcl_platform(platform) "windows"] &&
	![string equal [lindex [file system $dir] 0] "native"]} {
	# If it is a wrapped executable running on windows, the openssl
	# dlls must be copied out of the virtual filesystem to the disk
	# where Windows will find them when resolving the dependency in
	# the tls dll. We choose to make them siblings of the executable.
	package require starkit
	set dst [file nativename [file dirname $starkit::topdir]]
	foreach sdll [glob -nocomplain -directory $dir -tails *eay32.dll] {
	    catch {file delete -force            $dst/$sdll}
	    catch {file copy   -force $dir/$sdll $dst/$sdll}
	}
    }
    set res [catch {uplevel #0 [list load [file join [pwd] $dll]]} err]
    catch {cd $cwd}
    if {$res} {
	namespace eval [namespace parent] {namespace delete tls}
	return -code $res $err
    }
    rename tls::initlib {}
}

#
# Backwards compatibility, also used to set the default
# context options
#
proc tls::init {args} {
    variable defaults

    set defaults $args
}
#
# Helper function - behaves exactly as the native socket command.
#
proc tls::socket {args} {
    variable socketCmd
    variable defaults
    set idx [lsearch $args -server]
    if {$idx != -1} {
	set server 1
	set callback [lindex $args [expr {$idx+1}]]
	set args [lreplace $args $idx [expr {$idx+1}]]

	set usage "wrong # args: should be \"tls::socket -server command ?options? port\""
	set options "-cadir, -cafile, -certfile, -cipher, -command, -dhparams, -keyfile, -myaddr, -password, -request, -require, -servername, -ssl2, -ssl3, -tls1, -tls1.1 or -tls1.2"
    } else {
	set server 0

	set usage "wrong # args: should be \"tls::socket ?options? host port\""
	set options "-async, -cadir, -cafile, -certfile, -cipher, -command, -dhparams, -keyfile, -myaddr, -myport, -password, -request, -require, -servername, -ssl2, -ssl3, -tls1, -tls1.1 or -tls1.2"
    }
    set argc [llength $args]
    set sopts {}
    set iopts [concat [list -server $server] $defaults]	;# Import options

    for {set idx 0} {$idx < $argc} {incr idx} {
	set arg [lindex $args $idx]
	switch -glob -- $server,$arg {
	    0,-async	{lappend sopts $arg}
	    0,-myport	-
	    *,-type	-
	    *,-myaddr	{lappend sopts $arg [lindex $args [incr idx]]}
	    *,-cadir	-
	    *,-cafile	-
	    *,-certfile	-
	    *,-cipher	-
	    *,-command	-
	    *,-dhparams -
	    *,-keyfile	-
	    *,-password	-
	    *,-request	-
	    *,-require	-
            *,-servername -
	    *,-ssl2	-
	    *,-ssl3	-
	    *,-tls1	-
	    *,-tls1.1	-
	    *,-tls1.2	{lappend iopts $arg [lindex $args [incr idx]]}
	    -*		{return -code error "bad option \"$arg\": must be one of $options"}
	    default	{break}
	}
    }
    if {$server} {
	if {($idx + 1) != $argc} {
	    return -code error $usage
	}
	set uid [incr ::tls::srvuid]

	set port [lindex $args [expr {$argc-1}]]
	lappend sopts $port
	#set sopts [linsert $sopts 0 -server $callback]
	set sopts [linsert $sopts 0 -server [list tls::_accept $iopts $callback]]
	#set sopts [linsert $sopts 0 -server [list tls::_accept $uid $callback]]
    } else {
	if {($idx + 2) != $argc} {
	    return -code error $usage
	}
	set host [lindex $args [expr {$argc-2}]]
	set port [lindex $args [expr {$argc-1}]]
	lappend sopts $host $port
    }
    #
    # Create TCP/IP socket
    #
    set chan [eval $socketCmd $sopts]
    if {!$server && [catch {
	#
	# Push SSL layer onto socket
	#
	eval [list tls::import] $chan $iopts
    } err]} {
	set info ${::errorInfo}
	catch {close $chan}
	return -code error -errorinfo $info $err
    }
    return $chan
}

# tls::_accept --
#
#   This is the actual accept that TLS sockets use, which then calls
#   the callback registered by tls::socket.
#
# Arguments:
#   iopts	tls::import opts
#   callback	server callback to invoke
#   chan	socket channel to accept/deny
#   ipaddr	calling IP address
#   port	calling port
#
# Results:
#   Returns an error if the callback throws one.
#
proc tls::_accept { iopts callback chan ipaddr port } {
    log 2 [list tls::_accept $iopts $callback $chan $ipaddr $port]

    set chan [eval [list tls::import $chan] $iopts]

    lappend callback $chan $ipaddr $port
    if {[catch {
	uplevel #0 $callback
    } err]} {
	log 1 "tls::_accept error: ${::errorInfo}"
	close $chan
	error $err $::errorInfo $::errorCode
    } else {
	log 2 "tls::_accept - called \"$callback\" succeeded"
    }
}
#
# Sample callback for hooking: -
#
# error
# verify
# info
#
proc tls::callback {option args} {
    variable debug

    #log 2 [concat $option $args]

    switch -- $option {
	"error"	{
	    foreach {chan msg} $args break

	    log 0 "TLS/$chan: error: $msg"
	}
	"verify"	{
	    # poor man's lassign
	    foreach {chan depth cert rc err} $args break

	    array set c $cert

	    if {$rc != "1"} {
		log 1 "TLS/$chan: verify/$depth: Bad Cert: $err (rc = $rc)"
	    } else {
		log 2 "TLS/$chan: verify/$depth: $c(subject)"
	    }
	    if {$debug > 0} {
		return 1;	# FORCE OK
	    } else {
		return $rc
	    }
	}
	"info"	{
	    # poor man's lassign
	    foreach {chan major minor state msg} $args break

	    if {$msg != ""} {
		append state ": $msg"
	    }
	    # For tracing
	    upvar #0 tls::$chan cb
	    set cb($major) $minor

	    log 2 "TLS/$chan: $major/$minor: $state"
	}
	default	{
	    return -code error "bad option \"$option\":\
		    must be one of error, info, or verify"
	}
    }
}

proc tls::xhandshake {chan} {
    upvar #0 tls::$chan cb

    if {[info exists cb(handshake)] && \
	$cb(handshake) == "done"} {
	return 1
    }
    while {1} {
	vwait tls::${chan}(handshake)
	if {![info exists cb(handshake)]} {
	    return 0
	}
	if {$cb(handshake) == "done"} {
	    return 1
	}
    }
}

proc tls::password {} {
    log 0 "TLS/Password: did you forget to set your passwd!"
    # Return the worlds best kept secret password.
    return "secret"
}

proc tls::log {level msg} {
    variable debug
    variable logcmd

    if {$level > $debug || $logcmd == ""} {
	return
    }
    set cmd $logcmd
    lappend cmd $msg
    uplevel #0 $cmd
}