#!/bin/sh
# The next line is executed by /bin/sh, but not tcl \
exec wish $0 ${1+"$@"}

##############################################################################
# Simple wizard like tool to build an AndroWish based app as APK.
#
#    Page 1:  package tree                  (which components are included)
#    Page 2:  file tree of .../assets/app                 (custom Tcl code)
#    Page 3:  AndroidManifest.xml                            (App manifest)
#    Page 3a: App icons                        (App icons in various sizes)
#    Page 4:  build options                      (CPU support, APK signing)
#    Page 5:  cleanup and build        (APK generation using gradle or ant)
#
# Copyright (c) 2015-2025 Christian Werner chw at ch minus werner dot de
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tk 8.5
if {[catch {package require Img}]} {
    catch {package require tkpng}
}
catch {package require tkdnd}

##############################################################################
# AndroWish logo

image create photo aw -data \
{
R0lGODlhRgAyAOf/AD0/kz5AlD9BlUhEjkpElExGlkZJl0tKjUxLjklLmlVQT05MkFZRUEtNnFdS
UVFPk1hUU1lVVFVQm1pWVVtXVlRUklxYVl5aWF9aWWBbWlVYomJdXFdapGNfXmVgX2BekF5enGBd
omdiYVxhpWlkY2pmZGVjlmxnZm5paGdolG9qaXBraXBsanFta2RrqWtqqnRvbm1umnVxb3dycXp1
dHF1m3Vzs314d3J3qXV2sHt3n396eYB7end8r4F9mn5+rIaBgH1+uYeCgYWBt4aGnIKGrYyHhn+H
tJGLioqKrIuLoZONjI6OpI+PpZCQppaRj5KSwZSUqpyWlZObhJ+amZqZyZ6at5efs6OenaCcxqGd
x52gyaGirKijoZ6iyqCks6mko6ulpKCosKGlzaeppqGqsa+pqKmoy6qqzaytt7Ktq6qvsbOurKq3
hZ/AVbCv06uzu6q3t7ez0ajGTbG8l7C6tbm4r6nHTqPJTbm107G8qqrIT764t6XKT7W/mqTLV7m7
uKrKV8C6ub2416vLWLTBoru70qzMWcG8uq3NWsO9vL2/vLq92rrCqrTEqq3OYq/NcMS/va7PY7LO
arHOcbTLibPNfbXPZLrHp7LPcrbOeLTQbLnLkb3Io7/D0sjDwbbRbbnOhsXFvLbQgLjNmMTD27fS
brjPjcTGw7jTb8bG3bfVd8fJxsfH3r7UeLjWeM/KyL/Xgc3K28zM483Py8Hbi9DP58jbjMfck9HT
0NjS0dPV0tfT5dXX1NzX1dja19HjqODa2dfb69rc2djc7Nvd2tre7t3f3NXnq+Te3d7g3d/g6uDi
39votN7mztrqvOPj7uPl4dzrveLqveTm4+vl5OHsxubo5ebn8eLtx+fp5uTuyOjq5+Xvyenr6Onq
9OLwz+/q6OPx0Orw0uzs9+vu6vDu8u7w7evz2+/x7uz13PHz8PP18vn08vP35vT45/j1+vT38/L5
7vX56Pb49PT67/749/X88Pn7+Pz78vr8+ff9//v9+vz/+/7//P///yH5BAEKAP8ALAAAAABGADIA
AAj+AP8JHEiwoMGDBB1M2HDixAYLDhBKnEixIkILJ8LsCsfPn0d/+rTpwnLCgsWTKCVGmLEo3seX
MD2yEyQjQsqbFiPQUBazZ89hMiLiHFpQRTCfSHvuIkGUqAMpSaPG5LeEQdOUEVBJ3QpT0ISrFjFE
40r2YzKTYFUyK8vW3y+hN3m1ynPmzBgvWrJU0TLGiiFexsxFzQesrcdPcE/aEjjoTBUbAQBInjy5
wZA3rZbB6wlMnWF/YdKqglKAsunJHM4Q2/eSX63P/lik/Tdri4TTpwMEKUXu4zRc4MChY3vM5uw0
jG7jNi1BjjNXfaJHv4SsHlkgszGw87fMxvLTODr+7ZEu/c82rufQXkXy0dyW76YTxIFEPvqe81tv
pPX1cp8qA/BRlkQl9fWxRzdbfQJWBj0REwJuH6RgWhGWRHcIKNFJshU+GFwlhE/QvJCbDkQcQNkV
k/QRCzjSibMVDVcpghQ2OeD2ABExUAbHIfW9JpUZV/WS1DdDLFeDD5MRgEl9eyTYlAPlRGVOFpGd
ZgIRA0j2Qyb1bTWMAkRZsNU+smiAWwVKLCCZJ9I880wzzWyVjnE4ecCVOqSsMcJpCDChZginBHJI
Io9wpd5NG3DlTnSj6CHGEcoB0KeadUh3x1b60HlTBPZs9U59j5ziSBkuSNrEAj1QEl0gW2mTWEr+
Dowl1acFRqdJIV+A4MQCjVi4VS5X0eJpgYmAUssjfdzBCRdRRMHjIVsBcpUaw5IHCoZ9HHKJKasc
QgcXfmS7lRRXtVCthdjWd4gkoYjiBrRSMdWUBS5FRWt0f6Rb6x2P3GJdUtx8dRUfs9b3Sq0FbjJO
Ul2kBUPB5B2yCsL1pZKUvFc5UIy9tcYCyiOBUNzHvzHBYlVaKnBM8SGmbPLIHneQd0tHU3kwm0Ay
InWvyH08kgoosbwCjB3a9MTGzQJlQI/OPNcKrTaKrAPTOh0i/Y8MNMe0c9O++pNMJPp8hM8JVg9k
hE9bcw2vP7uw8tEOZRMURk9pN722P1L7Q25+3AM5QIXWXKsLEz9P8G3QDO28VDfPd68jm+EGZZDM
S/VUbnkz9Ykzz+bzvDPPR78cCnlCQHjjkzX1eRbTNTy8OnpBExhxTkyok6f6R94IIfrrF6lABjcf
1S6d6tV0gcLuvFMUgQg3PNFGfVPQ4IHryeNUX/VIkzcH9tn3AXlAADs=
}

##############################################################################
# Some globals.

if {$tcl_platform(platform) eq "windows"} {
    set nullin "<NUL:"
    set nullout ">NUL:"
    set nullerr "2>NUL:"
} else {
    set nullin "</dev/null"
    set nullout ">/dev/null"
    set nullerr "2>/dev/null"
}

##############################################################################
# Some bindings.

proc treeview_focus {w} {
    if {![::tk::FocusOK $w]} {
	return
    }
    set item [$w focus]
    if {$item eq ""} {
	catch {
	    set item [lindex [$w children {}] 0]
	    $w focus $item
	    $w see $item
	    ttk::treeview::select.choose.browse $w $item
	}
    }
}

bind Treeview <FocusIn> {treeview_focus %W}

proc imgframe_focus {w in} {
    if {![::tk::FocusOK $w]} {
	return
    }
    if {$in} {
	$w configure -bg \#E00000
    } else {
	$w configure -bg white
    }
}

bind ImgFrame <FocusIn>  {imgframe_focus %W 1}
bind ImgFrame <FocusOut> {imgframe_focus %W 0}

##############################################################################
# Test if file name is executable, see ticket [ef70c85ae9]

proc is_exec {filename} {
    if {$::tcl_platform(platform) eq "windows"} {
	foreach ext {.bat .exe .cmd} {
	    set n ${filename}${ext}
	    if {[file exists $n]} {
		return $n
	    }
	}
    } elseif {[file executable $filename]} {
	return $filename
    }
    return ""
}

##############################################################################
# Setup names for external progams.
# Try certain environment variables to resolve absolute paths to tools.

proc setup_tools {} {
    array set ::exe {
	adb	adb
	android {}
	ant	ant
	fossil	fossil
    }
    if {[info exists ::env(ANT_HOME)]} {
	set x [is_exec [file join $::env(ANT_HOME) bin ant]]
	if {$x ne ""} {
	    set ::exe(ant) $x
	}
    }
    if {[info exists ::env(ANDROID_HOME)]} {
	set x [is_exec [file join $::env(ANDROID_HOME) platform-tools adb]]
	if {$x ne ""} {
	    set ::exe(adb) $x
	}
	set x [is_exec [file join $::env(ANDROID_HOME) tools android]]
	if {$x ne ""} {
	    set ::exe(android) $x
	}
    }
}

##############################################################################
# Find out where we are.
# Result is written to global ::basedir (toplevel directory of SDK or source),
# current dir is set to ::basedir for subprocesses.

proc where_am_i {} {
    set dir [file normalize [file dirname [info script]]]
    while {1} {
	set a [file join $dir assets]
	if {[file isdirectory $a] && [file isfile [file join $a INVENTORY]]} {
	    break
	}
	set u [file normalize [file join $dir ..]]
	if {$u eq $dir} {
	    tk_messageBox -icon error \
		-message "Inventory not found." \
		-detail "Cannot proceed further." \
		-title Error -type ok
	    exit 1
	}
	set dir $u
    }
    set ::basedir $dir
    catch {cd $dir}
    set localprops [file join $dir local.properties]
    if {![file readable $localprops]} {
	set err "android tool not available"
	if {$::exe(android) eq "" || [catch {
	    exec [list $::exe(android)] update project -p $dir $::nullin 2>@1
	} err]} {
	    lputs stderr $err
	    if {[info exists ::env(ANDROID_HOME)]} {
		set ahome $::env(ANDROID_HOME)
		if {$::tcl_platform(platform) eq "windows"} {
		    set ahome [string map [list \\ /] $ahome]
		}
		if {![catch {open $localprops w} f]} {
		    puts $f "sdk.dir=$ahome"
		    close $f
		}
	    } else {
		lputs stderr \
		    "ANDROID_HOME not set, local.properties not written"
	    }
	}
    }
}

##############################################################################
# Setup gradle if available.
# Try certain environment variables to resolve absolute paths to tools.

proc setup_gradle {} {
    set dir $::basedir
    catch {unset ::exe(gradle)}
    if {$::tcl_platform(platform) eq "windows"} {
	if {[file readable [file join $dir gradlew.bat]]} {
	    set ::exe(gradle) [file join $dir gradlew.bat]
	}
    } elseif {[file executable [file join $dir gradlew]]} {
	set ::exe(gradle) [file join $dir gradlew]
    }
    # preset some globals
    foreach arg $::argv {
	switch -- $arg {
	    -nob -
	    -nobu -
	    -nobui -
	    -nobuil -
	    -nobuild {
		set ::page4(clonly) "nobuild"
	    }
	}
    }
}

##############################################################################
# Test if PNG images can be read. When not available code for page to
# change App icons is removed.

proc check_png_support {} {
    if {[catch {aw read [file join $::basedir tools/androwish.png]}] &&
	[catch {aw read [file join $::basedir sdktools/androwish.png]}]} {
	rename make_page3a {}
	rename show_page3a {}
	rename icon_popup {}
	rename icon_popup_key {}
	rename icon_popup_cmd {}
    }
}

##############################################################################
# Invoke browser on wiki page for this tool

proc show_wiki {} {
    if {$::tcl_platform(platform) eq "windows"} {
	# first argument to "start" is "window title", which is not used here
	set cmd [list {*}[auto_execok start] {}]
    } elseif {$::tcl_platform(os) eq "Darwin"} {
	set cmd [auto_execok open]
    } else {
	set cmd [auto_execok xdg-open]
    }
    if {[string length $cmd]} {
	set url "http://www.androwish.org/index.html/wiki?name=AndroWish+SDK"
	catch {exec {*}$cmd $url $::nullin $::nullout $::nullerr &}
    }
}

##############################################################################
# Read inventory from .../assets/INVENTORY.
# INVENTORY must be in proper list format, each component entry consisting
# of at least two elements, the first is a tag ("req" for required,
# "opt" for optional component), the second is the path pattern of the
# component, e.g. "assets/tcl8*", the third is a list of depending source
# directory and/or shared libraries.
# Result is written to global variable ::inventory

proc get_inventory {} {
    if {[catch {open [file join $::basedir assets/INVENTORY] r} file]} {
	tk_messageBox -icon error \
	    -message "Inventory not found." \
	    -detail "Cannot proceed further." \
	    -title Error -type ok
	exit 1
    }
    if {[catch {read $file} inv]} {
	catch {close $file}
	tk_messageBox -icon error \
	    -message "Inventory not readable." \
	    -detail "Cannot proceed further." \
	    -title Error -type ok
	exit 1
    }
    catch {close $file}
    set count 0
    set req {}
    if {[catch {
	foreach item $inv {
	    if {[lindex $item 0] eq "req"} {
		lappend req [lindex $item 2]
	    }
	    incr count
	}}] || ($count == 0)} {
	tk_messageBox -icon error \
	    -message "Inventory is corrupt or empty." \
	    -detail "Cannot proceed further." \
	    -title Error -type ok
	exit 1
    }
    # if required .../jni and .../src stuff is not present,
    # assume we are in SDK
    set count 0
    set pcount 0
    foreach r $req {
	foreach pat $r {
	    if {[string match {*$arch*} $pat]} {
		continue
	    }
	    incr count
	    set l [glob -nocomplain [file join $::basedir $pat *]]
	    if {[llength $l]} {
		incr pcount
	    }
	}
    }
    set ::sdk [expr {$count != $pcount}]
    set ::inventory $inv
}

##############################################################################
# Get supported/configured architectures.
# Result is written to global variable ::arch_list

proc get_arch_list {} {
    set list1 [glob -nocomplain -type d -tails \
		   -directory [file join $::basedir libs] *]
    set list2 [glob -nocomplain -type d -tails \
		   -directory [file join $::basedir _casket/libs] *]
    set list3 ""
    if {![catch {open [file join $::basedir jni/Application.mk] r} amk]} {
	set txt ""
	catch {set txt [read $amk 100000]}
	close $amk
	regexp -line {^[[:blank:]]*APP_ABI.*=(.*)$} $txt all list3
	set list3 [string trim $list3]
	if {[catch {llength $list3}]} {
	    set list3 {}
	}
    }
    array set p {armeabi 1 armeabi-v7a 1 mips 1 x86 1 arm64-v8a 1 x86_64 1}
    array set a {}
    foreach name1 $list1 name2 $list2 name3 $list3 {
	if {[info exists p($name1)]} {
	    set a($name1) 1
	}
	if {[info exists p($name2)]} {
	    set a($name2) 1
	}
	set name2 [string trimleft $name2 "_"]
	if {[info exists p($name2)]} {
	    set a($name2) 1
	}
	if {[info exists p($name3)]} {
	    set a($name3) 1
	}
    }
    set ::arch_list [lsort -dictionary [array names a]]
}

##############################################################################
# Read information from AndroidManifest.xml

proc get_manifest {} {
    set ::manifest [file join $::basedir AndroidManifest.xml]
    set list [read_amxml $::manifest]
    if {[llength $list] < 4} {
	tk_messageBox -icon error \
	    -message "Unable to parse AndroidManifest.xml." \
	    -detail "Cannot proceed further." \
	    -title Error -type ok
	exit 1
    }
    lassign $list ::pkg_name ::cls_name ::app_name ::permissions
}

##############################################################################
# Test if we are in a checked out source tree.

proc check_source_tree {} {
    if {!$::sdk} {
	if {[catch {exec [list $::exe(fossil)] status $::nullin 2>@1} err]} {
	    lputs stderr $err
	    set answer \
		[tk_messageBox -icon error \
		     -message "Source tree is not a fossil checkout." \
		     -detail "Files will be potentially modified and deleted\
without providing a fallback.\nContinue anyway?" -title Error -type yesno]
	    if {$answer ne "yes"} {
		exit 1
	    }
	} elseif {[catch {
		exec [list $::exe(fossil)] changes $::nullin 2>@1
	    } ret] || ($ret ne "")} {
	    lputs stderr $ret
	    set answer \
		[tk_messageBox -icon error \
		     -message "Source tree has uncommited changes." \
		     -detail "This may result from a prior run of this tool.\
Continue?" -title Error -type yesno]
	    if {$answer ne "yes"} {
		exit 1
	    }
	}
    }
}

##############################################################################
# Fill treeview from ::inventory compared to current contents
# of file system

proc pkg_fill_tree {tree} {
    $tree delete [$tree children {}]
    set npkgs 0
    set tpkgs 0
    foreach item $::inventory {
	lassign $item type pat1 pat2
	if {$type ne "opt"} {
	    continue
	}
	incr npkgs
	set l [glob -nocomplain [file join $::basedir $pat1 *]]
	if {[llength $l]} {
	    set txt [file tail $pat1]
	    regsub -all -- {[*]} $txt {} txt
	    regsub -all -- {\[.*\]} $txt {} txt
	    set id [$tree insert {} end -values [list "\u2718" $txt] -open 1]
	    incr tpkgs
	}
    }
    if {$npkgs > $tpkgs} {
	.action.b1 configure -state normal
    } else {
	.action.b1 configure -state disabled
    }
    .action.b2 configure -state disabled
}

##############################################################################
# Change action button states according to Treeview states

proc pkg_tree_set_buttons {tree} {
    set tpkgs 0
    set dpkgs 0
    foreach item [$tree children {}] {
	incr tpkgs
	if {[$tree set $item sel] eq ""} {
	    incr dpkgs
	}
    }
    set npkgs 0
    foreach item $::inventory {
	lassign $item type pat1 pat2
	if {$type ne "opt"} {
	    continue
	}
	incr npkgs
    }
    if {($npkgs > $tpkgs) || $dpkgs} {
	.action.b1 configure -state normal
    } else {
	.action.b1 configure -state disabled
    }
    if {$dpkgs} {
	.action.b2 configure -state normal
    } else {
	.action.b2 configure -state disabled
    }
}

##############################################################################
# Events on package tree items (open/close/button)

proc pkg_tree_sel {tree what {x 0} {y 0}} {
    if {$what eq "button"} {
	set col [$tree identify column $x $y]
	if {$col eq "#1"} {
	    set item [$tree identify row $x $y]
	    if {$item ne ""} {
		$tree focus $item
		set state [expr ![$tree item $item -open]]
		$tree item $item -open $state
		if {$state} {
		    $tree set $item sel "\u2718"
		} else {
		    $tree set $item sel ""
		}
		pkg_tree_set_buttons $tree
		return -code break
	    } else {
		lassign [$tree identify $x $y] what where detail
		if {$what eq "heading"} {
		    set count_on 0
		    set count_off 0
		    foreach item [$tree children {}] {
			if {[$tree set $item sel] ne ""} {
			    incr count_on
			} else {
			    incr count_off
			}
		    }
		    if {$count_on == 0} {
			# make all on
			foreach item [$tree children {}] {
			    $tree item $item -open 1
			    $tree set $item sel "\u2718"
			}
		    } else {
			# make all off
			foreach item [$tree children {}] {
			    $tree item $item -open 0
			    $tree set $item sel ""
			}
		    }
		    pkg_tree_set_buttons $tree
		    return -code break
		}
	    }
	}
    }
    if {[set item [$tree focus]] ne ""} {
	if {$what eq "open"} {
	    $tree set $item sel "\u2718"
	} else {
	    $tree set $item sel ""
	}
	pkg_tree_set_buttons $tree
    }
}

############################################################################
# Based on xml.tcl -- Simple XML parser by Keith Vetter, March 2004

namespace eval ::XML {
    variable XML ""
    variable COM
    array set COM {}
    variable CDATA
    array set CDATA {}
    variable loc 0
}

##############################################################################
# Init parser with XML string

proc ::XML::Init {xmlData} {
    variable XML
    variable loc
    variable COM
    array unset COM
    variable CDATA
    array unset CDATA
    set XML [string trim $xmlData]
    # Hold comments in COM array
    set count 1
    set loc 0
    while {[regexp -start $loc -indices {<!--(.*?)-->} $XML all com]} {
	lassign $all all0 all1
	lassign $com com0 com1
	set loc [expr {$all1 + 1}]
	set COM($count) [string range $XML $com0 $com1]
	set loc [expr {$loc - [string length $COM($count)]}]
	set XML [string replace $XML $com0 $com1 COM($count)]
	set loc [expr {$loc + [string length COM($count)]}]
	incr count
    }
    set count 1
    set loc 0
    # Hold CDATA payload in CDATA array
    while {[regexp -start $loc -indices {^!\[CDATA\[(.*?)\]\]} $XML all cd]} {
	lassign $all all0 all1
	lassign $com cd0 cd1
	set loc [expr {$all1 + 1}]
	set CDATA($count) [string range $XML $cd0 $cd1]
	set loc [expr {$loc - [string length $CDATA($count)]}]
	set XML [string replace $XML $com0 $com1 CDATA($count)]
	set loc [expr {$loc + [string length CDATA($count)]}]
	incr count
    }
    # Reset to start
    set loc 0
}

##############################################################################
# Returns {XML|COM|TXT|EOF|PI value attributes START|END|EMPTY}

proc ::XML::NextToken {{peek 0}} {
    variable XML
    variable loc
    variable COM
    variable CDATA
    set n [regexp -start $loc -indices {(.*?)\s*?<(/?)(.*?)(/?)>} \
               $XML all txt stok tok etok]
    if {!$n} {return [list EOF]}
    lassign $all all0 all1
    lassign $txt txt0 txt1
    lassign $stok stok0 stok1
    lassign $tok tok0 tok1
    lassign $etok etok0 etok1
    if {$txt1 >= $txt0} {                       ;# Got text
        set txt [string range $XML $txt0 $txt1]
        if {!$peek} {set loc [expr {$txt1 + 1}]}
        return [list TXT $txt]
    }
    set token [string range $XML $tok0 $tok1]   ;# Got something in brackets
    if {!$peek} {set loc [expr {$all1 + 1}]}
    if {[regexp {^!--(.*)--$} $token => com]} { ;# Is it a comment?
        return [list COM [set $com]]
    }
    if {[regexp {^!\[CDATA\[(.*)\]\]} $token => txt]} { ;# Is it CDATA stuff?
        return [list TXT [set $txt]]
    }
    # Check for Processing Instruction <?...?>
    set type XML
    if {[regexp {^\?(.*)\?$} $token => token]} {
        set type PI
    }
    set attrs {}
    regexp {^(.*?)\s+(.*?)$} $token => token attrs
    set etype START                             ;# Entity type
    if {$etok0 <= $etok1} {
        if {$stok0 <= $stok1} { set token "/$token"} ;# Bad XML
        set etype EMPTY
    } elseif {$stok0 <= $stok1} {
        set etype END
    }
    return [list $type $token $attrs $etype]
}

##############################################################################
# Returns dictionary from attributes

proc ::XML::Values {attrs} {
    set result {}
    set nattrs {}
    set st 0
    set str ""
    foreach c [split $attrs ""] {
	switch -- $c {
	    "\n" - " " - "\t" {
		switch $st {
		    0 {
			continue
		    }
		    1 {
			set st 0
			lappend nattrs $str
			set str ""
			continue
		    }
		}
		append str $c
	    }
	    "\"" {
		switch $st {
		    0 - 1 {
			set st 2
		    }
		    2 {
			append str $c
			set st 0
			lappend nattrs $str
			set str ""
			continue
		    }
		}
		append str $c
	    }
	    "'" {
		switch $st {
		    0 - 1 {
			set st 3
		    }
		    3 {
			append str $c
			set st 0
			lappend nattrs $str
			set str ""
			continue
		    }
		}
		append str $c
	    }
	    default {
		switch $st {
		    0 {
			set st 1
		    }
		}
		append str $c
	    }
	}
    }
    if {$st} {
	lappend nattrs $str
    }
    foreach attr $nattrs {
	set n [string first "=" $attr]
	set name [string range $attr 0 $n-1]
	set value [string range $attr $n+1 end]
	if {[string match {"*"} $value]} {
	    set value [string trim $value "\""]
	} elseif {[string match {'*'} $value]} {
	    set value [string trim $value "'"]
	}
	dict set result $name [string trim $value "\"'"]
    }
    return $result
}

##############################################################################
# Returns attributes as string from dictionary

proc ::XML::Attrs {dict} {
    set result ""
    set sep ""
    dict for {key value} $dict {
	if {[string match "*\"*" $value]} {
	    set q "'"
	} else {
	    set q "\""
	}
	append result $sep $key "=" $q $value $q
	set sep " "
    }
    return $result
}

##############################################################################
# Populate the roots of a file tree

proc ft_fill_roots {tree} {
    foreach dir [lsort -dictionary [file volumes]] {
	set fstype [lindex [file system $dir] 0]
	if {$fstype ne "native"} {
	    continue
	}
	ft_fill_tree $tree [$tree insert {} end -text $dir \
				-values [list $dir directory]]
    }
}

##############################################################################
# Populate a node of the file tree

proc ft_fill_tree {tree node {open 0}} {
    if {![string match "*irectory" [$tree set $node type]]} {
	return
    }
    if {$open < 0} {
	$tree delete [$tree children $node]
	$tree set $node type "directory"
	# make this node openable
	$tree insert $node 0 -text dummy ;# a dummy
	return
    }
    if {[$tree set $node type] ne "directory"} {
	# already processed
	return
    }
    set path [$tree set $node fullpath]
    $tree delete [$tree children $node]
    set filelist {}
    set toopen {}
    catch {set filelist [lsort -dictionary [glob -nocomplain -dir $path *]]}
    foreach f $filelist {
	set type "file"
	catch {set type [file type $f]}
	set id [$tree insert $node end -text [file tail $f] \
		-values [list $f $type]]
	if {$type eq "directory"} {
	    set fstype [lindex [file system $f] 0]
	    if {$fstype eq "native"} {
		# make this node openable
		$tree insert $id 0 -text dummy ;# a dummy
		if {$open > 0} {
		    lappend toopen $id
		}
	    }
	}
    }
    # stop this code from rerunning on the current node
    $tree set $node type processedDirectory
    if {$open && [llength $filelist]} {
	$tree item $node -open 1
    }
    foreach id $toopen {
	ft_fill_tree $tree $id $open
    }
}

##############################################################################
# Post popup menu in file tree

proc ft_tree_popup {tree x y} {
    set popup -1
    set ::ft_tree(item) ""
    set ::ft_tree(names) ""
    set m [winfo parent $tree].popup
    set last [$m index last]
    set col [$tree identify column $x $y]
    if {$col eq "#0"} {
	set item [$tree identify row $x $y]
	if {$item ne ""} {
	    set ::ft_tree(item) $item
	    # "Copy" allowed
	    $m entryconfigure 0 -state normal
	    if {$last >= 2} {
		# "Delete" allowed
		$m entryconfigure 2 -state normal
	    }
	    set popup 0
	}
    }
    if {[catch {clipboard get -displayof $tree -type FILE_NAME} names]} {
	if {[catch {clipboard get -displayof $tree -type STRING} names]} {
	    set names ""
	} else {
	    set names [split $names "\n"]
	}
    }
    if {$names ne ""} {
	set newnames {}
	foreach name $names {
	    set name [ft_check_file $name]
	    if {$name ne ""} {
		lappend newnames $name
	    }
	}
	set names $newnames
    }
    if {$names ne ""} {
	set ::ft_tree(names) $names
	if {$::ft_tree(item) eq ""} {
	    set ::ft_tree(item) [$tree children {}]
	}
	if {$last >= 1} {
	    # "Paste" allowed
	    if {[llength $names] > 1} {
		set txt "Paste \"[ft_abbrev [lindex $names 0]]\" \u2026"
	    } else {
		set txt "Paste \"[ft_abbrev $names]\""
	    }
	    $m entryconfigure 1 -state normal -label $txt
	}
	set popup 1
    } else {
	if {$last >= 1} {
	    # "Paste" disabled
	    $m entryconfigure 1 -state disabled -label Paste
	}
    }
    if {$::ft_tree(item) eq [$tree children {}]} {
	# "Copy" disabled
	$m entryconfigure 0 -state disabled
	if {$last >= 2} {
	    # "Delete" disabled
	    $m entryconfigure 2 -state disabled
	}
    }
    if {$popup >= 0} {
	incr x [winfo rootx $tree]
	incr y [winfo rooty $tree]
	::tk_popup $m $x $y $popup
    }
}

proc ft_tree_popup_key {tree} {
    set item [$tree focus]
    if {$item ne ""} {
	lassign [$tree bbox $item] x y w h
	incr x [expr {$w / 2}]
	incr y [expr {$h / 2}]
	ft_tree_popup $tree $x $y
    }
}

##############################################################################
# Abbreviate file name for "Paste" menu entry.

proc ft_abbrev {file} {
    set dir [file dirname $file]
    set file [file tail $file]
    if {$dir eq "/"} {
	set dir ""
    } elseif {[string length $dir] > 10} {
	set dir [string trimright [string range $dir 0 9] "/"]
	append dir "\u2026"
    }
    if {[string length $file] > 16} {
	set file [string range $file 0 16]
	append file "\u2026"
    }
    return "${dir}/$file"
}

##############################################################################
# Check file type for copy operations. Only accept regular files
# and directories, i.e. exclude device special files, sockets, etc.

proc ft_check_file {file} {
    while {1} {
	if {![file exists $file]} {
	    set file ""
	    break
	}
	switch -- [file type $file] {
	    file - directory {
		# accept
		break
	    }
	    link {
		if {[catch {file readlink $file} lfile]} {
		    set file ""
		    break
		}
		if {[file pathtype $lfile] eq "relative"} {
		    set file [file join [file dirname $file] $lfile]
		} else {
		    set file [file normalize $lfile]
		}
		# recheck
		continue
	    }
	    default {
		set file ""
		break
	    }
	}
    }
    return $file
}

##############################################################################
# Handle popup menu command in file tree

proc ft_popup_cmd {tree cmd} {
    set item $::ft_tree(item)
    switch -- $cmd {
	copy {
	    if {$item ne ""} {
		set file [$tree set $item fullpath]
		set file [ft_check_file $file]
		catch {
		    clipboard clear -displayof $tree
		    if {$file ne ""} {
			clipboard append -displayof $tree -type FILE_NAME -- \
			    $file
		    }
		}
	    }
	}
	paste {
	    if {$::ft_tree(names) ne ""} {
		if {![string match "*irectory" [$tree set $item type]]} {
		    set item [$tree parent $item]
		}
		set dest [$tree set $item fullpath]
		foreach name $::ft_tree(names) {
		    if {[cp $name $dest] > 0} {
			$tree set $item type "directory"
			ft_fill_tree $tree $item 1
		    }
		}
		clipboard clear -displayof $tree
		selection clear -displayof $tree
	    }
	}
	delete {
	    if {$item ne ""} {
		set file [$tree set $item fullpath]
		if {[rm $file] > 0} {
		    $tree delete $item
		}
	    }
	}
    }
}

##############################################################################
# Handle drop in file tree

proc ft_tree_drop_file {tree rootx rooty files} {
    set popup -1
    set item ""
    set x [expr {$rootx - [winfo rootx $tree]}]
    set y [expr {$rooty - [winfo rooty $tree]}]
    set col [$tree identify column $x $y]
    if {$col eq "#0"} {
	set item [$tree identify row $x $y]
	if {$item eq ""} {
	    return
	}
    }
    if {$files ne ""} {
	if {![string match "*irectory" [$tree set $item type]]} {
	    set item [$tree parent $item]
	}
	set dest [$tree set $item fullpath]
	foreach name $files {
	    if {[cp $name $dest] > 0} {
		$tree set $item type "directory"
		ft_fill_tree $tree $item 1
	    }
	}
    }
}

##############################################################################
# Handle selection on a file tree

proc ft_selection {tree} {
    set item [$tree selection]
    set item [lindex $item 0]
    if {$item ne ""} {
	set file [$tree set $item fullpath]
	set file [ft_check_file $file]
	clipboard clear -displayof $tree
	if {$file ne ""} {
	    clipboard append -displayof $tree -type FILE_NAME -- $file
	}
    }
}

##############################################################################
# Remove file(s) like rm(1)
# Returns number of succesful "file delete" invocations.

proc rm {file {force 1}} {
    set count 0
    set dopts "--"
    if {$force} {
	set dopts "-force --"
    }
    foreach f [glob -nocomplain -- $file] {
	lputs stdout "rm $f"
	if {[catch {file delete {*}$dopts $f} err]} {
	    lputs stderr $err
	} else {
	    incr count
	}
    }
    return $count
}

##############################################################################
# Move/rename files or directories similar to mv(1)
# Optional parameter tcheck: check timestamps, only overwrite
# destination when source is newer; otherwise, destination is
# kept and source removed.
# Returns number of succesful "file rename" invocations.

proc mv {oldpat newpat {tcheck 0}} {
    set count 0
    set newname [lindex [glob -nocomplain -- $newpat] 0]
    if {$newname eq ""} {
	set newname $newpat
    }
    foreach f [glob -nocomplain -- $oldpat] {
	set newdir [file dirname $newname]
	catch {file mkdir $newdir}
	if {$tcheck} {
	    if {[file isdirectory $newname]} {
		set n [file join $newname [file tail $f]]
		if {[file exists $n]} {
		    set tdst [file mtime $n]
		} else {
		    set tcheck 0
		}
	    } elseif {[catch {set tdst [file mtime $newname]}]} {
		set tcheck 0
	    }
	}
	if {$tcheck} {
	    if {![file isdirectory $f]} {
		if {[catch {set tsrc [file mtime $f]}]} {
		    set tcheck 0
		}
	    }
	}
	if {$tcheck && ($tsrc <= $tdst)} {
	    lputs stdout "rm $f"
	    if {[catch {file delete -force -- $f} err]} {
		lputs stderr $err
	    } else {
		incr count
	    }
	    continue
	}
	lputs stdout "mv $f $newname"
	if {[catch {file rename -force -- $f $newname} err]} {
	    lputs stderr $err
	} else {
	    incr count
	}
    }
    return $count
}

##############################################################################
# Copy file(s) like cp(1)
# Returns number of succesful "file copy" invocations.

proc cp {src dest} {
    set count 0
    set dest [file normalize $dest]
    foreach f [glob -nocomplain -- $src] {
	set f [file normalize $f]
	if {[file type $f] eq "directory"} {
	    # prevent from recursive loops when copying directories
	    set p $f
	    set root [lindex [file split $p] 0]
	    while {$p ne $root} {
		if {[file normalize $p] eq [file normalize $dest]} {
		    break
		}
		# prevent from nasty endless loop on virtualized fs
		set pd [file dirname $p]
		if {$pd eq $p} {
		    set p [file normalize ${p}/..]
		} else {
		    set p $pd
		}
	    }
	    if {$p ne $root} {
		continue
	    }
	    set p $dest
	    set root [lindex [file split $p] 0]
	    while {$p ne $root} {
		if {[file normalize $f] eq [file normalize $p]} {
		    break
		}
		# prevent from nasty endless loop on virtualized fs
		set pd [file dirname $p]
		if {$pd eq $p} {
		    set p [file normalize ${p}/..]
		} else {
		    set p $pd
		}
	    }
	    if {$p ne $root} {
		continue
	    }
	}
	lputs stdout "cp $f $dest"
	if {[catch {file copy -force -- $f $dest} err]} {
	    lputs stderr $err
	} else {
	    incr count
	}
    }
    return $count
}

##############################################################################
# Balloon help borrowed from http://wiki.tcl.tk/3060

namespace eval balloon {
    set last 0
    namespace export balloon
}

proc ::balloon::balloon {args} {
    variable last
    variable tips
    set numArgs [llength $args]
    if {($numArgs < 1) || ($numArgs > 2)} {
        return -code error \
	    "wrong # args: should be \"balloon widget ?text?\""
    }
    set w [lindex $args 0]
    if {![winfo exists $w]} {
        return -code error "bad window path name \"$w\""
    }
    if {[winfo class $w] == "Toplevel"} {
        return -code error "cannot create tooltip for toplevel windows"
    }
    if {$numArgs == 1} {
        if {[info exists tips($w)]} {
	    return $tips($w)
	} else {
	    return {}
	}
    }
    set text [lindex $args 1]
    if {$text eq ""} {
        # turn off tooltip
        if {[set x [lsearch [bindtags $w] "Balloon"]] >= 0} {
	    bindtags $w [lreplace [bindtags $w] $x $x]
	}
        unset -nocomplain tips($w)
        trace remove command $w delete ::balloon::autoclear
        return
    }
    # OK, set up a (new?) tooltip
    if {[lsearch [bindtags $w] "Balloon"] < 0} {
        bindtags $w [linsert [bindtags $w] 0 "Balloon"]
    }
    if {[lsearch [trace info command $w] {delete ::balloon::autoclear}] < 0} {
        trace add command $w delete ::balloon::autoclear
    }
    set tips($w) $text
}

proc ::balloon::show {w} {
    variable tips
    if {![info exists tips($w)]} {
	return
    }
    if {[winfo containing {*}[winfo pointerxy .]] ne $w} {
	return
    }
    set top "$w.balloon"
    catch {destroy $top}
    toplevel $top -bd 1 -bg black
    bind $top <Button-1> [list destroy $top]
    wm overrideredirect $top 1
    if {[string equal [tk windowingsystem] aqua]}  {
        ::tk::unsupported::MacWindowStyle style $top help none
    }
    pack [message $top.txt -aspect 10000 -bg lightyellow -text $tips($w)]
    set wmx [winfo rootx $w]
    set wmy [expr [winfo rooty $w]+[winfo height $w]]
    wm geometry $top \
	[winfo reqwidth $top.txt]x[winfo reqheight $top.txt]+$wmx+$wmy
    raise $top
}

proc ::balloon::delay {} {
    variable last
    set then $last
    set last [clock seconds]
    if {[expr {$last - $then}] < 3} {
        return 50
    } else {
        return 1000
    }
}

proc ::balloon::autoclear {old new op} {
    variable tips
    unset -nocomplain tips([namespace tail $old])
}

namespace import ::balloon::balloon
bind Balloon <Enter> {after [::balloon::delay] [list ::balloon::show %W]}
bind Balloon <Leave> {destroy %W.balloon}

##############################################################################
# Revert all changes on source tree.

proc rev_pkgs {tree} {
    foreach item $::inventory {
	lassign $item type pat1 pat2
	if {$type ne "opt"} {
	    continue
	}
	set txt [file tail $pat1]
	regsub -all -- {[*]} $txt {} txt
	regsub -all -- {\[.*\]} $txt {} txt
	set pkgs($txt) [list $pat1 $pat2]
    }
    set cmds {}
    set casket [file normalize [file join $::basedir _casket]]
    foreach a $::arch_list {
	set enabled($a) [file isdirectory [file join $::basedir libs/$a]]
    }
    foreach pkg [lsort [array names pkgs]] {
	set f [file tail [lindex $pkgs($pkg) 0]]
	set d [file dirname [lindex $pkgs($pkg) 0]]
	set odir [file normalize [file join $casket $f]]
	set dir [file normalize [file join $::basedir $d]]
	lappend cmds [list mv $odir $dir]
	foreach d [lindex $pkgs($pkg) 1] {
	    if {[string match {*$arch*} $d]} {
		foreach a $::arch_list {
		    if {$enabled($a)} {
			set lib $d
			regsub -- {[$]arch} $lib $a lib
			set l [file join $casket $lib]
			set l2 [file join $::basedir $lib]
			lappend cmds [list mv $l $l2 1]
		    } else {
			set lib $d
			regsub -- {[$]arch} $lib $a lib
			set l [file join $casket $lib]
			set lib $d
			regsub -- {[$]arch} $lib _$a lib
			set l2 [file join $casket $lib]
			lappend cmds [list mv $l $l2 1]
		    }
		}
	    } else {
		set mk \
		    [glob -nocomplain [file join $::basedir $d Android.nomk]]
		foreach m $mk {
		    set m [file normalize $m]
		    set m2 [file join [file dirname $m] Android.mk]
		    lappend cmds [list mv $m $m2]
		}
	    }
	}
    }
    set count 0
    foreach cmd $cmds {
	{*}$cmd
	incr count
    }
    pkg_fill_tree $tree
}

##############################################################################
# Remove packages/directories according to treeview content.

proc rem_pkgs {tree} {
    foreach item $::inventory {
	lassign $item type pat1 pat2
	if {$type ne "opt"} {
	    continue
	}
	set txt [file tail $pat1]
	regsub -all -- {[*]} $txt {} txt
	regsub -all -- {\[.*\]} $txt {} txt
	set pkgs($txt) [list $pat1 $pat2]
    }
    foreach item [$tree children {}] {
	if {[$tree set $item sel] ne ""} {
	    unset -nocomplain pkgs([$tree set $item pkg])
	}
    }
    set cmds {}
    set casket [file normalize [file join $::basedir _casket]]
    file mkdir $casket
    foreach a $::arch_list {
	set enabled($a) [file isdirectory [file join $::basedir libs/$a]]
    }
    foreach pkg [lsort [array names pkgs]] {
	set dir \
	    [file normalize [file join $::basedir [lindex $pkgs($pkg) 0]]]
	lappend cmds [list mv $dir $casket]
	foreach d [lindex $pkgs($pkg) 1] {
	    if {[string match {*$arch*} $d]} {
		foreach a $::arch_list {
		    if {$enabled($a)} {
			set lib $d
			regsub -- {[$]arch} $lib $a lib
			set l [file join $::basedir $lib]
			set l2 [file join $casket $lib]
			lappend cmds [list mv $l $l2]
		    } else {
			set lib $d
			regsub -- {[$]arch} $lib _$a lib
			set l [file join $casket $lib]
			set lib $d
			regsub -- {[$]arch} $lib $a lib
			set l2 [file join $casket $lib]
			lappend cmds [list mv $l $l2]
		    }
		}
	    } else {
		set mk [glob -nocomplain [file join $::basedir $d Android.mk]]
		foreach m $mk {
		    set m [file normalize $m]
		    set m2 [file join [file dirname $m] Android.nomk]
		    lappend cmds [list mv $m $m2]
		}
	    }
	}
    }
    set count 0
    foreach cmd $cmds {
	{*}$cmd
	incr count
    }
    pkg_fill_tree $tree
}

##############################################################################
# Read AndroidManifest.xml
# Returns list of package name, class name, app name, and a dict of
# permissions with 1/0 states.

proc read_amxml {infile} {
    if {[catch {open $infile r} file]} {
	return {}
    }
    if {[catch {read $file} xml]} {
	catch {close $file}
	return {}
    }
    catch {close $file}
    ::XML::Init $xml
    set done 0
    set pkg {}
    set cls {}
    set app {}
    array set perm {}
    while {!$done} {
	lassign [::XML::NextToken] type value attrs etype
	switch -- $type {
	    COM {
		if {[regexp -nocase {uses-permission\s(.*)} $value => attrs]} {
		    set a [::XML::Values $attrs]
		    if {[dict exists $a android:name]} {
			set perm([dict get $a android:name]) 0
		    }
		}
	    }
	    XML {
		switch -- $etype {
		    EMPTY - START {
			if {$value eq "manifest"} {
			    set a [::XML::Values $attrs]
			    if {[dict exists $a package]} {
				set pkg [dict get $a package]
			    }
			} elseif {$value eq "application"} {
			    set a [::XML::Values $attrs]
			    if {[dict exists $a android:label]} {
				set app [dict get $a android:label]
			    }
			} elseif {$value eq "activity"} {
			    if {$cls eq ""} {
				set a [::XML::Values $attrs]
				if {[dict exists $a android:name]} {
				    set cls [dict get $a android:name]
				}
			    }
			} elseif {$value eq "uses-permission"} {
			    set a [::XML::Values $attrs]
			    if {[dict exists $a android:name]} {
				set perm([dict get $a android:name]) 1
			    }
			}
		    }
		}
	    }
	    EOF {
		set done 1
	    }
	}
    }
    catch {
	set cls [lindex [split $cls "."] end]
    }
    return [list $pkg $cls $app [array get perm]]
}

##############################################################################
# Read build.xml
# Returns project name which is the base name of the output APK.

proc read_bxml {infile} {
    if {[catch {open $infile r} file]} {
	return {}
    }
    if {[catch {read $file} xml]} {
	catch {close $file}
	return {}
    }
    catch {close $file}
    ::XML::Init $xml
    set done 0
    set name ""
    while {!$done} {
	lassign [::XML::NextToken] type value attrs etype
	switch -- $type {
	    XML {
		switch -- $etype {
		    EMPTY - START {
			if {$value eq "project"} {
			    set a [::XML::Values $attrs]
			    if {[dict exists $a name]} {
				set name [dict get $a name]
			    }
			}
		    }
		}
	    }
	    EOF {
		set done 1
	    }
	}
    }
    return $name
}

##############################################################################
# Read settings.gradle
# Returns root project name which is the base name of the output APK.

proc read_sgr {infile} {
    if {[catch {open $infile r} file]} {
	return {}
    }
    if {[catch {read $file 65536} data]} {
	catch {close $file}
	return {}
    }
    catch {close $file}
    foreach line [split $data "\n"] {
	if {[string match "rootProject.name*=*" $line]} {
	    set index [string first "=" $line]
	    incr index
	    set name [string trim [string range $line $index end]]
	    set name [string trim $name "\""]
	    return $name
	}
    }
    return {}
}

##############################################################################
# Simple file browser window

proc browse_files {parent} {
    set f .brfiles
    if {[winfo exists $f]} {
	wm deiconify $f
	return
    }
    toplevel $f
    wm protocol $f WM_DELETE_WINDOW [list wm withdraw $f]
    wm title $f "bones - File Browser"
    wm transient $f .
    set m [menu $f.popup -tearoff 0]
    $m add command -label Copy -command [list ft_popup_cmd $f.tree copy] \
	-state disabled
    ttk::treeview $f.tree -columns {fullpath type} -displaycolumns {} \
	-yscroll [list $f.scroll set] -selectmode browse -show tree
    ttk::scrollbar $f.scroll -orient vertical -command [list $f.tree yview]
    bind $f.tree <<TreeviewOpen>> {ft_fill_tree %W [%W focus]}
    bind $f.tree <<TreeviewClose>> {ft_fill_tree %W [%W focus] -1}
    # bind $f.tree <<TreeviewSelect>> {ft_selection %W}
    bind $f.tree <3> {ft_tree_popup %W %x %y}
    bind $f.tree <F10> {ft_tree_popup_key %W}
    set dir [file normalize [file join $::basedir assets/app]]
    ft_fill_roots $f.tree
    grid $f.tree -row 0 -column 0 -sticky nsew
    grid $f.scroll -row 0 -column 1 -sticky ns
    grid columnconfigure $f 0 -weight 1
    grid rowconfigure $f 0 -weight 1
    return $f
}

##############################################################################
# Write an AndroidManifest.xml string given parameters

proc write_amxml {infile pkg cls app permv} {
    set indent 0
    set out ""
    catch {
	set cls [join [concat [split $pkg "."] $cls] "."]
    }
    array set perm {}
    array set perm $permv
    if {[catch {open $infile r} file]} {
	return {}
    }
    if {[catch {read $file} xml]} {
	catch {close $file}
	return {}
    }
    catch {close $file}
    ::XML::Init $xml
    set done 0
    while {!$done} {
	lassign [::XML::NextToken] type value attrs etype
	switch -- $type {
	    PI {
		append out [string repeat " " $indent]
		append out "<?$value $attrs?>" "\n"
	    }
	    COM {
		if {[regexp -nocase {uses-permission\s(.*)} $value => attrs]} {
		    if {[array exists perm]} {
			unset -nocomplain a
			foreach p [lsort -dictionary [array names perm]] {
			    append out [string repeat " " $indent]
			    if {$perm($p)} {
				set s "<uses-permission"
				set e " />"
			    } else {
				set s "<!--uses-permission"
				set e "-->"
			    }
			    dict set a android:name $p
			    append out "$s [::XML::Attrs $a]$e" "\n"
			}
			unset perm
		    }
		} else {
		    append out [string repeat " " $indent]
		    append out "<!--$value-->" "\n"
		}
	    }
	    XML {
		switch -- $etype {
		    EMPTY - START {
			set ignore 0
			set a [::XML::Values $attrs]
			if {$value eq "manifest"} {
			    dict set a package $pkg
			} elseif {$value eq "application"} {
			    dict set a android:label $app
			} elseif {$value eq "activity"} {
			    dict set a android:label $app
			    if {[info exists cls]} {
				dict set a android:name $cls
				unset cls
			    }
			} elseif {$value eq "uses-permission"} {
			    set ignore 1
			    if {[array exists perm]} {
				foreach p \
				    [lsort -dictionary [array names perm]] {
				    append out [string repeat " " $indent]
				    if {$perm($p)} {
					set s "<uses-permission"
					set e " />"
				    } else {
					set s "<!--uses-permission"
					set e "-->"
				    }
				    dict set a android:name $p
				    append out "$s [::XML::Attrs $a]$e" "\n"
				}
				unset perm
			    }
			}
			if {!$ignore} {
			    set attrs [::XML::Attrs $a]
			    append out [string repeat " " $indent]
			    if {$etype eq "EMPTY"} {
				append out "<$value $attrs />" "\n"
			    } else {
				if {$attrs eq ""} {
				    append out "<$value>" "\n"
				} else {
				    append out "<$value $attrs>" "\n"
				}
				incr indent 2
			    }
			}
		    }
		    END {
			if {$value eq "manifest"} {
			    if {[array exists perm]} {
				unset -nocomplain a
				foreach p \
				    [lsort -dictionary [array names perm]] {
				    append out [string repeat " " $indent]
				    if {$perm($p)} {
					set s "<uses-permission"
					set e " />"
				    } else {
					set s "<!--uses-permission"
					set e "-->"
				    }
				    dict set a android:name $p
				    append out "$s [::XML::Attrs $a]$e" "\n"
				}
				unset perm
			    }
			}
			incr indent -2
			append out [string repeat " " $indent]
			append out "</$value>" "\n"
		    }
		}
	    }
	    EOF {
		set done 1
	    }
	}
    }
    return $out
}

##############################################################################
# Page 1: package tree

proc make_page1 {parent} {
    set f $parent.page1
    frame $f
    ttk::treeview $f.tree -columns {sel pkg} -yscroll [list $f.scroll set] \
	-show headings -selectmode browse
    ttk::scrollbar $f.scroll -orient vertical -command [list $f.tree yview]
    $f.tree heading sel -text "\u2718"
    $f.tree heading pkg -text "Packages"
    $f.tree column pkg -stretch 1
    $f.tree column sel -width 20 -stretch 0 -anchor center
    bind $f.tree <Leave> break
    bind $f.tree <Motion> break
    bind $f.tree <ButtonPress-1> {pkg_tree_sel %W button %x %y}
    bind $f.tree <<TreeviewOpen>>  {pkg_tree_sel %W open}
    bind $f.tree <<TreeviewClose>> {pkg_tree_sel %W close}
    grid $f.tree -row 0 -column 0 -sticky nsew
    grid $f.scroll -row 0 -column 1 -sticky ns
    grid columnconfigure $f 0 -weight 1
    grid rowconfigure $f 0 -weight 1
    return $f
}

proc show_page1 {parent} {
    set f $parent.page1
    catch {wm withdraw .brfiles}
    if {![winfo exists $f]} {
	make_page1 $parent
    }
    foreach w [winfo children $parent] {
	pack forget $w
    }
    pack $f -side top -fill both -expand 1
    .action.b1 configure -text "Revert" -command [list rev_pkgs $f.tree]
    .action.b2 configure -text "Remove packages" -command \
	[list rem_pkgs $f.tree]
    pack .action.b2 -before .action.b3 -side left -padx 10 -expand 1
    .action.b3 configure -text "Next" -command [list show_page2 $parent]
    .top.title configure -text \
        "\nAndroWish Surgery\nSelect packages to include in the APK.\n"
    pkg_fill_tree $f.tree
}

##############################################################################
# Page 2: file tree of .../assets/app

proc make_page2 {parent} {
    set f $parent.page2
    frame $f
    ttk::treeview $f.tree -columns {fullpath type} -displaycolumns {} \
	-yscroll [list $f.scroll set] -selectmode browse
    ttk::scrollbar $f.scroll -orient vertical -command [list $f.tree yview]
    $f.tree heading \#0 -text "App specific files/directories"
    set m [menu $f.popup -tearoff 0]
    $m add command -label Copy -command [list ft_popup_cmd $f.tree copy] \
	-state disabled
    $m add command -label Paste -command [list ft_popup_cmd $f.tree paste] \
	-state disabled
    $m add command -label Delete -command [list ft_popup_cmd $f.tree delete] \
	-state disabled
    set dir [file normalize [file join $::basedir assets/app]]
    file mkdir $dir
    bind $f.tree <<TreeviewOpen>> {ft_fill_tree %W [%W focus]}
    bind $f.tree <<TreeviewClose>> {ft_fill_tree %W [%W focus] -1}
    bind $f.tree <3> {ft_tree_popup %W %x %y}
    bind $f.tree <F10> {ft_tree_popup_key %W}
    grid $f.tree -row 0 -column 0 -sticky nsew
    grid $f.scroll -row 0 -column 1 -sticky ns
    grid columnconfigure $f 0 -weight 1
    grid rowconfigure $f 0 -weight 1
    catch {
	tkdnd::drop_target register $f.tree DND_Files
	bind $f.tree <<Drop:DND_Files>> {ft_tree_drop_file %W %X %Y %D}
    }
    return $f
}

proc show_page2 {parent} {
    set f $parent.page2
    if {![winfo exists $f]} {
	make_page2 $parent
    }
    foreach w [winfo children $parent] {
	pack forget $w
    }
    pack $f -side top -fill both -expand 1
    .action.b1 configure -text "Back" -command [list show_page1 $parent] \
	-state normal
    .action.b2 configure -text "Browse files ..." \
	-command [list browse_files $parent] -state normal
    .action.b3 configure -text "Next" -command [list show_page3 $parent] \
	-state normal
    .top.title configure -text \
        "\nAndroWish Surgery\nAdd (paste) files in .../assets/app folder.\n"
    $f.tree delete [$f.tree children {}]
    set dir [file normalize [file join $::basedir assets/app]]
    ft_fill_tree $f.tree [$f.tree insert {} end -text .../assets/app \
				-values [list $dir directory]] 1
}

##############################################################################
# Page 3: AndroidManifest.xml

proc make_page3 {parent} {
    set f $parent.page3
    frame $f
    set row 0
    foreach {name label} {
	pkg_name {Package name: }
	cls_name {Class name: }
	app_name {App name: }
    } {
	frame $f.$name
	grid $f.$name -row $row -column 0 -sticky ew
	label $f.$name.l -anchor e -text $label -width 14
	ttk::entry $f.$name.e -width 32 -textvariable ::page3($name) \
	    -validate key -validatecommand "${name}_validate %W %P"
	pack $f.$name.l $f.$name.e -side left -pady 8
	incr row
    }
    ttk::treeview $f.tree -columns {sel perm} -show headings \
	-yscroll [list $f.scroll set] -selectmode browse -height 5
    ttk::scrollbar $f.scroll -orient vertical -command [list $f.tree yview]
    $f.tree heading sel -text "\u2718"
    $f.tree heading perm -text "App permissions"
    $f.tree column perm -stretch 1
    $f.tree column sel -width 20 -stretch 0 -anchor center
    bind $f.tree <Leave> break
    bind $f.tree <Motion> break
    bind $f.tree <ButtonPress-1> {perm_tree_sel %W button %x %y}
    bind $f.tree <<TreeviewOpen>>  {perm_tree_sel %W open}
    bind $f.tree <<TreeviewClose>> {perm_tree_sel %W close}
    grid $f.tree -row $row -column 0 -sticky nsew
    grid $f.scroll -row $row -column 1 -sticky ns
    grid columnconfigure $f 0 -weight 1
    grid rowconfigure $f $row -weight 1
    return $f
}

proc show_page3 {parent} {
    set f $parent.page3
    catch {wm withdraw .brfiles}
    if {![winfo exists $f]} {
	make_page3 $parent
    }
    foreach w [winfo children $parent] {
	pack forget $w
    }
    foreach name {pkg_name cls_name app_name} {
	set ::page3($name) [set ::$name]
    }
    $f.tree delete [$f.tree children {}]
    foreach p [lsort -dictionary [dict keys $::permissions]] {
	if {[dict get $::permissions $p]} {
	    set sel "\u2718"
	    set state 1
	} else {
	    set sel ""
	    set state 0
	}
	$f.tree insert {} end -values [list $sel $p] -open $state
    }
    pack $f -side top -fill both -expand 1
    .action.b1 configure -text "Back" -command [list show_page2 $parent] \
	-state normal
    .action.b2 configure -text "Make manifest" \
	-command [list make_manifest $f.tree] -state disabled
    pack .action.b2 -before .action.b3 -side left -padx 10 -expand 1
    .action.b3 configure -text "Next" -state disabled
    if {[info procs show_page3a] ne ""} {
	.action.b3 configure -command [list show_page3a $parent]
    } else {
	.action.b3 configure -command [list show_page4 $parent]
    }
    .top.title configure -text \
        "\nAndroWish Surgery\nSet properties in App manifest.\n"
    after cancel check_manifest
    check_manifest
}

##############################################################################
# Handle events on permission treeview.

proc perm_tree_sel {tree what {x 0} {y 0}} {
    if {$what eq "button"} {
	set col [$tree identify column $x $y]
	if {$col eq "#1"} {
	    set item [$tree identify row $x $y]
	    if {$item ne ""} {
		$tree focus $item
		set state [expr ![$tree item $item -open]]
		$tree item $item -open $state
		if {$state} {
		    $tree set $item sel "\u2718"
		} else {
		    $tree set $item sel ""
		}
		check_manifest $tree
		return -code break
	    } else {
		lassign [$tree identify $x $y] what where detail
		if {$what eq "heading"} {
		    set count_on 0
		    set count_off 0
		    foreach item [$tree children {}] {
			if {[$tree set $item sel] ne ""} {
			    incr count_on
			} else {
			    incr count_off
			}
		    }
		    if {$count_on == 0} {
			# make all on
			foreach item [$tree children {}] {
			    $tree item $item -open 1
			    $tree set $item sel "\u2718"
			}
		    } else {
			# make all off
			foreach item [$tree children {}] {
			    $tree item $item -open 0
			    $tree set $item sel ""
			}
		    }
		    check_manifest $tree
		    return -code break
		}
	    }
	}
    }
    if {[set item [$tree focus]] ne ""} {
	if {$what eq "open"} {
	    $tree set $item sel "\u2718"
	} else {
	    $tree set $item sel ""
	}
	check_manifest $tree
    }
}

##############################################################################
# Entry validation on package name,
# should be package name with two or more components.

proc pkg_name_validate {w new} {
    if {[regexp -nocase -- \
	     {^([a-zA-Z][a-zA-Z_\d]*)*([.]([a-zA-Z][a-zA-Z_\d]*)*)*$} $new]} {
	after cancel check_manifest
	after idle check_manifest
        return 1
    }
    return 0
}

##############################################################################
# Entry validation on class name.

proc cls_name_validate {w new} {
    if {[regexp -nocase -- {^([a-zA-Z][a-zA-Z_\d]*)*$} $new]} {
	after cancel check_manifest
	after idle check_manifest
        return 1
    }
    return 0
}

##############################################################################
# Entry validation on App name.

proc app_name_validate {w new} {
    if {[regexp -nocase -- {^([^<>{}\*\?\[\]\(\)`'\"&;\\/:\$])*$} $new]} {
	after cancel check_manifest
	after idle check_manifest
        return 1
    }
    return 0
}

##############################################################################
# Check if AndroidManifest.xml must be re-created.

proc check_manifest {{tree {}}} {
    set cont 0
    set nomk 0
    set make 0
    if {$tree ne ""} {
	foreach item [$tree children {}] {
	    if {[$tree set $item sel] eq ""} {
		set state 0
	    } else {
		set state 1
	    }
	    if {[dict get $::permissions [$tree set $item perm]] != $state} {
		incr make
	    }
	}
    }
    foreach name {pkg_name cls_name app_name} {
	if {$::page3($name) eq ""} {
	    incr nomk
	} elseif {[set ::$name] ne $::page3($name)} {
	    incr make
	}
    }
    if {!$nomk} {
	# check for Java source
	set src [file normalize [file join $::basedir src]]
	set dir [join [split $::page3(pkg_name) "."] "/"]
	set dir [file join $src $dir]
	set cls [file join $dir "$::page3(cls_name).java"]
	if {![file isdirectory $dir] || ![file isfile $cls]} {
	    incr make
	    set cont 0
	} elseif {!$make} {
	    incr cont
	}
    }
    if {$cont} {
	.action.b2 configure -state disabled
	.action.b3 configure -state normal
    } elseif {$make} {
	.action.b2 configure -state normal
	.action.b3 configure -state disabled
    }
    if {$nomk} {
	.action.b2 configure -state disabled
    }
}

##############################################################################
# Create new AndroidManifest.xml from data.

proc make_manifest {tree} {
    set perms $::permissions
    foreach item [$tree children {}] {
	if {[$tree set $item sel] eq ""} {
	    set state 0
	} else {
	    set state 1
	}
        dict set perms [$tree set $item perm] $state
    }
    set xml [write_amxml $::manifest $::page3(pkg_name) $::page3(cls_name) \
		 $::page3(app_name) $perms]
    if {($xml ne "") && ![catch {open $::manifest w} out]} {
	puts -nonewline $out $xml
	close $out
	set src [file normalize [file join $::basedir src]]
	if {$::pkg_name ne "tk.tcl.wish"} {
	    # remove old Java source and path
	    set dir [join [split $::pkg_name "."] "/"]
	    set dir [file join $src $dir]
	    set cls [file join $dir "$::cls_name.java"]
	    rm $cls
	    while {$dir ne $src} {
		# empty dirs only
		if {[rm $dir 0] == 0} {
		    break
		}
		set dir [file dirname $dir]
	    }
	}
	# write new Java source
	set dir [join [split $::page3(pkg_name) "."] "/"]
	set dir [file join $src $dir]
	set cls [file join $dir "$::page3(cls_name).java"]
	catch {file mkdir $dir}
	if {![catch {open $cls w} out]} {
	    puts $out "package $::page3(pkg_name);"
	    puts -nonewline $out "public class $::page3(cls_name)"
	    puts $out " extends tk.tcl.wish.AndroWish {"
	    puts $out "    /* empty class body */"
	    puts $out "}"
	    close $out
	    foreach name {pkg_name cls_name app_name} {
		set ::$name $::page3($name)
	    }
	    set ::permissions $perms
	    .action.b2 configure -state disabled
	    .action.b3 configure -state normal
	}
    }
}

##############################################################################
# Page 3a: App icons

proc make_page3a {parent} {
    set f $parent.page3a
    frame $f
    set m [menu $f.popup -tearoff 0]
    $m add command -label Paste -command [list icon_popup_cmd $f paste] \
	-state disabled
    $m add command -label Revert -command [list icon_popup_cmd $f revert] \
	-state normal
    set ::page3a(label) {}
    foreach {name row col rspan width height} {
	xxhdpi 0 0 3 144 144
	xhdpi  0 1 2  96  96
	hdpi   0 2 1  72  72
	mdpi   1 2 1  48  48
    } {
	frame $f.$name -bg white -takefocus 1 -class ImgFrame \
	    -width [expr {$width + 6}] -height [expr {$height + 6}]
	bind $f.$name <F10> {icon_popup_key %W}
	set img [image create photo -width $width -height $height]
	label $f.$name.i -image $img -bg black
	place $f.$name.i -anchor nw -width $width -height $height -x 3 -y 3
	bind $f.$name.i <3> {icon_popup %W %X %Y}
	catch {
	    tkdnd::drop_target register $f.$name.i DND_Files
	    bind $f.$name.i <<DropEnter>> [list $f.$name configure -bg yellow]
	    bind $f.$name.i <<DropLeave>> [list $f.$name configure -bg white]
	    bind $f.$name.i <<Drop:DND_Files>> {icon_drop_file %W %D}
	}
	grid $f.$name -row $row -column $col -rowspan $rspan -padx 5 -pady 5
	catch {$img read [file join $::basedir res/drawable-$name/icon.png]}
	balloon $f.$name.i "[string toupper $name] (${width}x${height})"
    }
    return $f
}

proc show_page3a {parent} {
    set f $parent.page3a
    if {![winfo exists $f]} {
	make_page3a $parent
    }
    foreach w [winfo children $parent] {
	pack forget $w
    }
    pack $f -side top -fill both -expand 1
    .action.b1 configure -text "Back" -command [list show_page3 $parent] \
	-state normal
    .action.b2 configure -text "Browse files ..." \
	-command [list browse_files $parent] -state normal
    pack .action.b2 -before .action.b3 -side left -padx 10 -expand 1
    .action.b3 configure -text "Next" -state normal
    .action.b3 configure -command [list show_page4 $parent]
    .top.title configure -text \
        "\nAndroWish Surgery\nSet App icons.\n"
}

proc icon_popup {label x y} {
    set ::page3a(label) $label
    if {[catch {clipboard get -displayof $label -type FILE_NAME} name]} {
	if {[catch {clipboard get -displayof $label -type STRING} name]} {
	    set name ""
	} else {
	    set name [lindex [split $name "\n"] 0]
	}
    }
    set m [winfo parent [winfo parent $label]].popup
    if {($name ne "") && [file readable $name] && [file isfile $name]} {
	set ::page3a(file) $name
	# "Paste" allowed
	$m entryconfigure 0 -state normal -label "Paste \"[ft_abbrev $name]\""
	set popup 0
    } else {
	# "Paste" disabled
	$m entryconfigure 0 -state disabled -label Paste
	set popup 1
    }
    ::tk_popup $m $x $y $popup
}

proc icon_popup_key {f} {
    set label $f.i
    set x [expr {[winfo rootx $f] + [winfo width $f] / 2}]
    set y [expr {[winfo rooty $f] + [winfo height $f] / 2}]
    icon_popup $label $x $y
}

proc icon_popup_cmd {f cmd} {
    set name [winfo name [winfo parent $::page3a(label)]]
    set img [$::page3a(label) cget -image]
    set orig [file join $::basedir res/drawable-$name/androwish.png]
    set dest [file join $::basedir res/drawable-$name/icon.png]
    set dorevert 0
    switch -- $cmd {
	paste {
	    if {$::page3a(file) eq ""} {
		return
	    }
	    clipboard clear -displayof $f
	    selection clear -displayof $f
	    $img blank
	    if {[icon_popup_imgcopy $img $::page3a(file) $dest]} {
		set dorevert 1
	    }
	}
	revert {
	    set dorevert 1
	}
    }
    if {$dorevert} {
	if {[cp $orig $dest]} {
	    $img blank
	    catch {$img read $dest}
	}
    }
}

proc icon_drop_file {label files} {
    set ::page3a(label) $label
    set m [winfo parent [winfo parent $label]].popup
    set name [winfo name [winfo parent $::page3a(label)]]
    set img [$::page3a(label) cget -image]
    set orig [file join $::basedir res/drawable-$name/androwish.png]
    set dest [file join $::basedir res/drawable-$name/icon.png]
    set dorevert 0
    $img blank
    set ::page3a(file) [lindex $files 0]
    if {[icon_popup_imgcopy $img $::page3a(file) $dest]} {
	set dorevert 1
    }
    if {$dorevert} {
	if {[cp $orig $dest]} {
	    $img blank
	    catch {$img read $dest}
	}
    }
}

proc icon_popup_imgcopy {img srcfile dstfile} {
    set newimg [image create photo]
    if {[catch {$newimg read $::page3a(file)}]} {
	return -1
    }
    set w [$img cget -width]
    set h [$img cget -height]
    if {([image width $newimg] != $w) || ([image height $newimg] != $h)} {
	set sx [expr {(1.0 * $w) / [image width $newimg]}]
	set sy [expr {(1.0 * $h) / [image height $newimg]}]
	if {[catch {
	    $img copy $newimg -to 0 0 $w $h -scale $sx $sy -filter lanczos
	}]} {
	    image delete $newimg
	    return -1
	}
	image delete $newimg
	if {[catch {$img write $dstfile -format png}]} {
	    return -1
	}
	return 0
    }
    if {[catch {$img copy $newimg}]} {
	image delete $newimg
	return -1
    }
    if {[cp $srcfile $dstfile] < 1} {
	return -1
    }
    return 0
}

##############################################################################
# Page 4: build options

proc make_page4 {parent} {
    set f $parent.page4
    frame $f
    label $f.arch -text "CPU support: " -width 16 -anchor e
    set alist $f.arch
    grid $f.arch -row 0 -column 0 -sticky ew
    set x 1
    set y 0
    foreach a $::arch_list {
	checkbutton $f.arch$a -offvalue 0 -onvalue 1 \
	    -variable ::page4(arch,$a) -text $a -anchor w \
	    -command [list check_page4 $f]
	lappend alist $f.arch$a
	grid $f.arch$a -row $y -column $x -sticky ew
	incr x
	if {$x > 2} {
	    set x 1
	    incr y
	}
    }
    label $f.debug -text "Build mode: " -width 16 -anchor e
    checkbutton $f.debugb -offvalue "release" -onvalue "debug" \
	-variable ::page4(debug) -text "Debug" -anchor w \
	-command [list check_page4 $f]
    checkbutton $f.clonly -offvalue "build" -onvalue "nobuild" \
	-variable ::page4(clonly) -text "Clean Only" -anchor w
    grid $f.debug $f.debugb $f.clonly -sticky ew -pady 12
    foreach n {key.store key.store.password key.alias key.alias.password} {
	set nn [string map {. {}} $n]
	label $f.$nn -text "$n: " -width 16 -anchor e
	ttk::entry $f.${nn}e -width 28 -textvariable ::page4($n) \
	    -validate key -validatecommand {keystore_validate %W %P}
	grid $f.$nn $f.${nn}e - - -sticky ew -pady 2
    }
    return $f
}

proc show_page4 {parent} {
    set f $parent.page4
    catch {wm withdraw .brfiles}
    if {![info exists ::page4(debug)]} {
	set ::page4(debug) "debug"
    }
    if {![info exists ::page4(clonly)]} {
	set ::page4(clonly) "build"
    }
    if {![winfo exists $f]} {
	make_page4 $parent
    }
    foreach w [winfo children $parent] {
	pack forget $w
    }
    foreach a $::arch_list {
	set l [glob -nocomplain -directory $::basedir libs/$a/*.so]
	set ::page4(arch,$a) [expr {[llength $l] > 0}]
    }
    set txt ""
    if {![catch {open [file join $::basedir ant.properties] r} apr]} {
	catch {set txt [read $apr 100000]}
	close $apr
    }
    set ::page4(antprops) {}
    foreach n {key.store key.store.password key.alias key.alias.password} {
	set re {^[[:blank:]]*}
	append re [string map {. {[.]}} $n]
	append re {[[:blank:]]*=[[:blank:]]*([^[:blank:]]+).*$}
	set val ""
	regexp -line $re $txt all val
	set ::page4($n) $val
	lappend ::page4(antprops) $val
    }
    pack $f -side top -fill both -expand 1
    .action.b1 configure -text "Back" -state normal
    if {[info procs show_page3a] ne ""} {
	.action.b1 configure -command [list show_page3a $parent]
    } else {
	.action.b1 configure -command [list show_page3 $parent]
    }
    .action.b2 configure -text "Make keystore" \
	-command [list make_keystore $f] -state disabled
    .action.b3 configure -text "Next" -command [list prepare_page5 $parent] \
	-state normal
    .top.title configure -text \
        "\nAndroWish Surgery\nSet build options and APK signing.\n"
    check_page4 $f
}

##############################################################################
# Entry validation on keystore entries.

proc keystore_validate {w new} {
    set f [winfo parent $w]
    after cancel [list check_page4 $w]
    after idle [list check_page4 $w]
    return 1
}

##############################################################################
# Check keystore entries and CPU checkbuttons.

proc check_page4 {f} {
    set mkenable 1
    foreach n {key.store key.store.password key.alias key.alias.password} {
	if {$::page4($n) eq ""} {
	    set ::page4(debug) "debug"
	    set mkenable 0
	    break
	}
    }
    if {$mkenable} {
	if {[file readable $::page4(key.store)]} {
	    set mkenable 0
	} else {
	    set ::page4(debug) "debug"
	}
    }
    if {$mkenable} {
	.action.b2 configure -state normal
    } else {
	.action.b2 configure -state disabled
    }
    set count 0
    foreach a $::arch_list {
	incr count $::page4(arch,$a)
    }
    if {$count == 0} {
	# at least one must be on
	foreach a $::arch_list {
	    set ::page4(arch,$a) 1
	    break
	}
    }
}

##############################################################################
# Create a new keystore from entries.

proc make_keystore {f} {
    set input "$::page4(key.store.password)\n"
    append input "$::page4(key.store.password)\n"
    append input "\n\n\n\n\n\ny\n"
    append input "$::page4(key.alias.password)\n"
    append input "$::page4(key.alias.password)\n"
    rm $::page4(key.store)
    set cmd [list |keytool -genkey -keystore $::page4(key.store)]
    lappend cmd -alias $::page4(key.alias) -keyalg RSA -keysize 2048
    lappend cmd -validity 10000 $::nullout
    set writeapr 0
    if {![catch {open $cmd WRONLY} f]} {
	catch {puts -nonewline $f $input}
	if {![catch {close $f} err]} {
	    set writeapr 1
	} else {
	    lputs stderr "keytool: $err"
	}
    } else {
	lputs stderr "keytool: $f"
    }
    if {$writeapr} {
	write_ant_props $f
    }
    check_page4 $f
}

##############################################################################
# Write ant.properties with page4 information

proc write_ant_props {f} {
    set txt ""
    if {![catch {open [file join $::basedir ant.properties] r} apr]} {
	catch {set txt [read $apr 100000]}
	close $apr
	set mods 0
	# order important!
	foreach n {
	    key.store.password key.store
	    key.alias.password key.alias
	} {
	    set re {^[[:blank:]]*}
	    append re [string map {. {[.]}} $n]
	    append re {[[:blank:]]*=[[:blank:]]*([^[:blank:]]+).*$}
	    if {[regsub -line $re $txt "${n}=$::page4($n)" txt] == 0} {
		if {$mods == 0} {
		    append txt "\n"
		}
		append txt $n "=" $::page4($n) "\n"
		incr mods
	    }
	}
	if {![catch {open [file join $::basedir ant.properties] w} apr]} {
	    puts -nonewline $apr $txt
	    close $apr
	    set ::page4(antprops) {}
	    foreach n {
		key.store key.store.password
		key.alias key.alias.password
	    } {
		lappend ::page4(antprops) $::page4($n)
	    }
	}
    }
}

##############################################################################
# Prepare JNI components and signing, then go to page 5

proc prepare_page5 {parent} {
    set antprops {}
    foreach n {
	key.store key.store.password
	key.alias key.alias.password
    } {
	lappend antprops $::page4($n)
    }
    if {$antprops ne $::page4(antprops)} {
	write_ant_props $parent
    }
    set casket [file normalize [file join $::basedir _casket]]
    set libs [file normalize [file join $::basedir libs]]
    foreach a $::arch_list {
	if {$::page4(arch,$a)} {
	    set src [file join $casket libs/_$a]
	    set dest [file join $libs $a]
	} else {
	    set src [file join $libs $a]
	    set dest [file join $casket libs/_$a]
	}
	if {[file isdirectory $src]} {
	    rm $dest 0
	    if {![file exists $dest]} {
		mv $src $dest
	    }
	}
    }
    show_page5 $parent
}

##############################################################################
# Page 5: cleanup and build

proc make_page5 {parent} {
    set f $parent.page5
    frame $f
    text $f.text -yscroll [list $f.scroll set] -state disabled \
	-wrap char -background white
    ttk::scrollbar $f.scroll -orient vertical -command [list $f.text yview]
    grid $f.text -row 0 -column 0 -sticky nsew
    grid $f.scroll -row 0 -column 1 -sticky ns
    grid columnconfigure $f 0 -weight 1
    grid rowconfigure $f 0 -weight 1
    return $f
}

proc show_page5 {parent} {
    set f $parent.page5
    if {![winfo exists $f]} {
	make_page5 $parent
    }
    foreach w [winfo children $parent] {
	pack forget $w
    }
    $f.text delete 1.0 end
    pack $f -side top -fill both -expand 1
    .action.b1 configure -text "Back" -command [list show_page4 $parent] \
	-state normal
    if {$::page4(clonly) eq "nobuild"} {
	set b2txt "Cleanup"
        set ttxt "\nAndroWish Surgery\nCleanup APK.\n"
    } else {
	set b2txt "Cleanup & build"
        set ttxt "\nAndroWish Surgery\nCleanup and build APK.\n"
    }
    .action.b2 configure -text $b2txt \
	-command [list cleanup_and_build $f.text] -state normal
    pack .action.b2 -before .action.b3 -side left -padx 10 -expand 1
    .action.b3 configure -text "Finish" -command exit -state normal
    .top.title configure -text $ttxt
}

##############################################################################
# Run ant to cleanup and build.

proc cleanup_and_build {text} {
    $text configure -state normal
    $text delete 1.0 end
    $text configure -state disabled
    # prefer gradle, to switch back to ant, the gradlew/gradlew.bat
    # files can be simply renamed to something else.
    if {[info exists ::exe(gradle)]} {
	if {$::page4(clonly) eq "nobuild"} {
	    set cmd "|[list $::exe(gradle)] clean $::nullin 2>@1"
	} else {
	    if {$::page4(debug) eq "release"} {
		set build "assembleRelease"
	    } else {
		set build "assembleDebug"
	    }
	    set cmd "|[list $::exe(gradle)] clean $build $::nullin 2>@1"
	}
    } else {
	if {$::page4(clonly) eq "nobuild"} {
	    set cmd "|[list $::exe(ant)] clean $::nullin 2>@1"
	} else {
	    set cmd "|[list $::exe(ant)] clean $::page4(debug) $::nullin 2>@1"
	}
    }
    if {[catch {open $cmd r} f]} {
	lputs stderr $f
	$text configure -state normal
	$text insert end $f
	$text insert end "\n"
	$text configure -state disabled
	$text see end
	return
    }
    fconfigure $f -blocking 0
    fileevent $f readable [list read_pipe_handler $text $f stop_build]
    .action.b1 configure -state disabled
    if {$::page4(clonly) eq "nobuild"} {
	set b2txt "Stop"
    } else {
	set b2txt "Stop build"
    }
    .action.b2 configure -text $b2txt -command [list stop_build $text $f]
}

##############################################################################
# Stop running gradle or ant.

proc stop_build {text f {eof 0}} {
    if {!$eof} {
	lputs stderr "*** build stopped"
    }
    if {[catch {close $f} err]} {
	if {$eof} {
	    lputs stderr $err
	}
    }
    .action.b1 configure -state normal
    if {$::tcl_platform(os) eq "Darwin"} {
	$text see end
	update
    }
    if {[$text search -- "BUILD SUCCESSFUL" 1.0 end] ne ""} {
	if {[info exists ::exe(gradle)]} {
	    set name [read_sgr [file join $::basedir settings.gradle]]
	    if {$name eq ""} {
		set name [file tail $::basedir]
	    }
	    set dir [file join $::basedir build outputs apk]
	    set apk [file join $dir "$name-$::page4(debug).apk"]
	    if {![file readable $apk]} {
		set dir [file join $dir $::page4(debug)]
		if {[file isdirectory $dir]} {
		    set apk [file join $dir "$name-$::page4(debug).apk"]
		}
	    }
	} else {
	    set name [read_bxml [file join $::basedir build.xml]]
	    if {$name eq ""} {
		set name AndroWishApp
	    }
	    set apk [file join $::basedir bin "$name-$::page4(debug).apk"]
	}
	if {[file readable $apk] &&
	    ![catch {exec [list $::exe(adb)] get-state $::nullerr} ret] &&
	    [string match "*device*" $ret]} {
	    .action.b2 configure -text "Install & run" \
		-command [list install_and_run $apk $text]
	    return
	}
    }
    if {$::page4(clonly) eq "nobuild"} {
	set b2txt "Cleanup"
    } else {
	set b2txt "Cleanup & build"
    }
    .action.b2 configure -text $b2txt -command [list cleanup_and_build $text]
}

##############################################################################
# File handler to read ant output etc. "endcmd" is invoked on EOF.

proc read_pipe_handler {text f endcmd} {
    if {[gets $f line] < 0} {
	if {[eof $f]} {
	    $endcmd $text $f 1
	    return
	}
    } else {
	lputs stdout $line
	$text configure -state normal
	$text insert end $line
	$text insert end "\n"
	$text configure -state disabled
	after cancel [list $text see end]
	after idle [list $text see end]
    }
    if {$::tcl_platform(os) eq "Darwin"} {
	$text see end
	update
    }
}

##############################################################################
# Run adb to install the new APK.

proc install_and_run {apk text} {
    set l .adblog
    if {![winfo exists $l]} {
	if {![catch {open "|[list $::exe(adb)] logcat $::nullin 2>@1" r} \
		  ::logcat(file)]} {
	    array set ::logcat {
		scroll 1 tV 0 tD 0 tI 0 tW 0 tE 1 tF 1
		ftV gray50 ftD black ftI blue ftW red4 ftE red ftF magenta
	    }
	    toplevel $l
	    wm protocol $l WM_DELETE_WINDOW [list adb_logcat_close $l]
	    wm title $l "bones - adb logcat"
	    if {$::tcl_platform(os) eq "Darwin"} {
		wm minsize $l 920 640
	    }
	    ttk::frame $l.frame
	    text $l.text -yscroll [list $l.scroll set] -state disabled \
		-wrap char -background white
	    ttk::scrollbar $l.scroll -orient vertical \
		-command [list $l.text yview]
	    grid $l.frame -row 0 -column 0 -columnspan 2 -sticky nsew
	    grid $l.text -row 1 -column 0 -sticky nsew
	    grid $l.scroll -row 1 -column 1 -sticky ns
	    grid columnconfigure $l 0 -weight 1
	    grid rowconfigure $l 1 -weight 1
	    ttk::button $l.frame.scroll -text "Lock" -width 6 \
		-command [list adb_logcat_scroll $l.frame.scroll]
	    ttk::button $l.frame.clear -text "Clear" -width 6 \
		-command [list adb_logcat_clear $l.text]
	    ttk::button $l.frame.run -text "Run" -width 6 \
		-command [list adb_logcat_run $l]
	    pack $l.frame.scroll $l.frame.clear $l.frame.run \
		-side left -padx 3 -pady 3
	    foreach tag {tF tE tW tI tD tV} {
		$l.text tag configure $tag -foreground $::logcat(f$tag)
		ttk::checkbutton $l.frame.$tag -offvalue 0 -onvalue 1 \
		    -variable ::logcat($tag) -text [string range $tag 1 1] \
		    -width 2 -command [list adb_logcat_fixtag $l.text $tag]
		pack $l.frame.$tag -side right
	    }
	    fconfigure $::logcat(file) -blocking 0
	    while {[gets $::logcat(file) line] >= 0} {
		# empty loop body
	    }
	    fileevent $::logcat(file) readable \
		[list adb_logcat_read $l.text $::logcat(file)]
	} else {
	    unset -nocomplain ::logcat(file)
	}
    } else {
	wm deiconify $l
    }
    set ::logcat(am_start) $::page3(pkg_name)/.$::page3(cls_name)
    $text configure -state normal
    $text insert end "\nINSTALLING APK $apk\n\n"
    $text configure -state disabled
    $text see end
    if {[catch {
	open "|[list $::exe(adb)] install -r $apk $::nullin 2>@1" r
    } f]} {
	lputs stderr $f
	$text configure -state normal
	$text insert end $f
	$text insert end "\n"
	$text configure -state disabled
	$text see end
	return
    }
    fconfigure $f -blocking 0
    fileevent $f readable [list read_pipe_handler $text $f stop_install]
    .action.b1 configure -state disabled
    .action.b2 configure -text "Stop install" \
	-command [list stop_install $text $f]
}

##############################################################################
# Stop installing. If EOF condition and no errors on "adb install" run
# were detected, try to start new APK using "adb shell am start ...".

proc stop_install {text f {eof 0}} {
    if {!$eof} {
	lputs stderr "*** install stopped"
    }
    if {[catch {close $f} err]} {
	if {$eof} {
	    lputs stderr $err
	}
    } elseif {$eof} {
	catch {exec [list $::exe(adb)] shell am start \
		   $::page3(pkg_name)/.$::page3(cls_name) \
		   $::nullin $::nullout $::nullerr}
    }
    .action.b1 configure -state normal
    if {$::page4(clonly) eq "nobuild"} {
	set b2txt "Cleanup"
    } else {
	set b2txt "Cleanup & build"
    }
    .action.b2 configure -text $b2txt -command [list cleanup_and_build $text]
}

##############################################################################
# Functions to deal with "adb logcat" output window.

proc adb_logcat_close {w} {
    catch {close $::logcat(file)}
    unset -nocomplain $::logcat(file)
    after cancel [list $w.text see end]
    destroy $w
}

proc adb_logcat_read {text f} {
    if {[gets $f line] < 0} {
	if {[eof $f]} {
	    adb_logcat_close [winfo toplevel $text]
	    return
	}
    } else {
	set tag t[string range $line 0 0]
	if {![info exists ::logcat($tag)]} {
	    set tag tV
	}
	if {!$::logcat($tag)} {
	    return
	}
	if {[string length $line] > 2048} {
	    set line [string range $line 0 2047]
	    append line "\u2026\n"
	} else {
	    append line "\n"
	}
	$text configure -state normal
	$text insert end $line $tag
	$text configure -state disabled
	if {$::logcat(scroll)} {
	    after cancel [list $text see end]
	    after idle [list $text see end]
	}
    }
}

proc adb_logcat_fixtag {text tag} {
    if {!$::logcat($tag)} {
	$text configure -state normal
	catch {$text delete {*}[$text tag ranges $tag]}
	$text configure -state disabled
    }
}

proc adb_logcat_scroll {button} {
    if {[$button cget -text] eq "Lock"} {
	$button configure -text "Scroll"
	set ::logcat(scroll) 0
    } else {
	$button configure -text "Lock"
	set ::logcat(scroll) 1
    }
}

proc adb_logcat_clear {text} {
    $text configure -state normal
    $text delete 1.0 end
    $text configure -state disabled
}

proc adb_logcat_run {button} {
    catch {exec [list $::exe(adb)] shell am start $::logcat(am_start) \
	       $::nullin $::nullout $::nullerr}
}

##############################################################################
# Build GUI.

wm withdraw .
wm title . [file tail [info script]]
if {$::tcl_platform(os) eq "Darwin"} {
    wm minsize . 920 640
} else {
    wm minsize . 400 350
}
frame .top
pack .top -side top -fill x -padx 10 -pady 10
frame .top.line1 -height 8 -bg white
frame .top.line2 -height 12 -bg \#a6c850
pack .top.line1 .top.line2 -side bottom -fill x
label .top.aw -image aw -bg white
pack .top.aw -side left -fill both -ipadx 12
label .top.title -bg white -fg \#3d3f93 -padx 5 -justify left -text \
    "\nAndroWish Surgery\n\n" -anchor w
pack .top.title -side left -expand 1 -fill x

bind .top.line2 <Double-1> show_log
bind .top.aw <Double-1> show_wiki
bind all <Control-l> show_log

frame .action
pack .action -side bottom -fill x -pady 10
ttk::button .action.b1 -width 10
ttk::button .action.b2 -width 16
ttk::button .action.b3 -width 10

frame .main -width 300 -height 200
pack propagate .main 0
pack .main -side top -fill both -expand 1 -padx 10 -pady 10

wm protocol . WM_DELETE_WINDOW exit

pack .action.b1 -side left -padx 10 -expand 1 -anchor w
pack .action.b2 -side left -padx 10 -expand 1
pack .action.b3 -side right -padx 10 -expand 1 -anchor e

toplevel .log
wm protocol .log WM_DELETE_WINDOW {wm withdraw .log}
wm title .log "bones - Log Messages"
wm withdraw .log

text .log.text -yscroll [list .log.scroll set] -state disabled \
    -wrap char -background white
ttk::scrollbar .log.scroll -orient vertical -command [list .log.text yview]
grid .log.text -row 0 -column 0 -sticky nsew
grid .log.scroll -row 0 -column 1 -sticky ns
grid columnconfigure .log 0 -weight 1
grid rowconfigure .log 0 -weight 1
.log.text tag configure stderr -foreground red
.log.text tag configure stdout -foreground black

proc show_log {} {
    wm transient .log .
    wm deiconify .log
}

proc lputs {chantag text} {
    append text "\n"
    .log.text configure -state normal
    .log.text insert end $text $chantag
    .log.text configure -state normal
    after cancel [list .log.text see end]
    after idle [list .log.text see end]
}

##############################################################################
# Preparations

setup_tools
where_am_i
setup_gradle
check_png_support
get_arch_list
get_inventory
get_manifest
check_source_tree

##############################################################################
# Ready for brain surgery ...

show_page1 .main

wm deiconify .

##############################################################################
# Local Variables:
# mode: tcl
# fill-column: 78
# End:
