punkapp application launch framework - initial

src/modules/punkapp-0.1.tm

@@ -0,0 +1,133 @@
+package provide punkapp [namespace eval punkapp {
+    variable version
+    set version 0.1
+}]
+
+namespace eval punkapp {
+    proc hide_dot_window {} {
+        #alternative to wm withdraw .
+        #see https://wiki.tcl-lang.org/page/wm+withdraw
+        wm geometry . 1x1+0+0
+        wm overrideredirect . 1
+        wm transient .
+    }
+    proc is_toplevel {w} {
+        if {![llength [info commands winfo]]} {
+            return 0
+        }
+        expr {[winfo toplevel $w] eq $w && ![catch {$w cget -menu}]}
+    }
+    proc get_toplevels {{w .}} {
+        if {![llength [info commands winfo]]} {
+            return [list]
+        }
+        set list {}
+        if {[is_toplevel $w]} {
+            lappend list $w
+        }
+        foreach w [winfo children $w] {
+            lappend list {*}[get_toplevels $w]
+        }
+        return $list
+    }
+    proc exit {{toplevel ""}} {
+        set toplevels [get_toplevels]
+        if {[string length $toplevel]} {
+            set wposn [lsearch $toplevels $toplevel]
+            if {$wposn > 0} {
+                destroy $toplevel
+            }
+        } else {
+            #review 
+            puts stderr "punkapp::exit called without toplevel - showing console"
+            show_console
+            return 0
+        }
+        
+        set controllable [get_user_controllable_toplevels]
+        if {![llength $controllable]} {
+            show_console
+        }
+    }
+    
+    proc get_visible_toplevels {{w .}} {
+        if {![llength [info commands winfo]]} {
+            return [list]
+        }
+        set list [get_toplevels $w]
+        set mapped [lmap v $list {expr {[winfo ismapped $v] ? $v : {}}}]
+        set mapped [concat {*}$mapped] ;#ignore {}
+        set visible [list]
+        foreach m $mapped {
+            if {[wm overrideredirect $m] == 0 } {
+                lappend visible $m
+            } else {
+                if {[winfo height $m] >1 && [winfo width $m] > 1} {
+                    #technically even a 1x1 is visible.. but in practice even a 10x10 is hardly likely to be noticeable when overrideredirect == 1
+                    #as a convention - 1x1 with no controls is used to make a window invisible so we'll treat anything larger as visible
+                    lappend visible $m
+                }
+            }
+        }
+        return $visible
+    }
+    proc get_user_controllable_toplevels {{w .}} {
+        set visible [get_visible_toplevels $w]
+        set controllable [list]
+        foreach v $visible {
+            if {[wm overrideredirect $v] == 0} {
+                append controllable $v
+            }
+        }
+        #only return visible windows with overrideredirect == 0 because there exists some user control.
+        #todo - review.. consider checking if position is outside screen areas? Technically controllable.. but not easily
+        return $controllable
+    }
+    proc hide_console {args} {
+        set defaults [dict create -force 0]
+        if {([llength $args] % 2) != 0} {
+            error "hide_console expects pairs of arguments. e.g -force 1"
+        }
+        set known_opts [dict keys $defaults]
+        dict for {k v} $args {
+            if {$k ni $known_opts} {
+                error "Unrecognised options '$k'  known options: $known_opts"
+            }
+        }
+        set opts [dict merge $defaults $args]
+        set force [dict get $opts -force]
+        
+        if {!$force} {
+            if {![llength [get_user_controllable_toplevels]]} {
+                puts stderr "Cannot hide console while no user-controllable windows available"
+                return 0
+            }
+        }
+        if {$::tcl_platform(platform) eq "windows"} {
+            package require twapi
+            set h [twapi::get_console_window]
+            twapi::hide_window $h 
+            return 1
+        } else {
+            #todo
+            puts stderr "punkapp::hide_console unimplemented on this platform (todo)"
+            return 0
+        }
+    }
+    
+    proc show_console {} {
+        if {$::tcl_platform(platform) eq "windows"} {
+            package require twapi
+            if {![catch {set h [twapi::get_console_window]} errM]} {
+                twapi::show_window $h -activate -normal
+            } else {
+                #no console - assume launched from something like wish? 
+                catch {console show}
+            }
+        } else {
+            #todo
+            puts stderr "punkapp::show_console unimplemented on this platform"
+        }
+    }
+    
+}

src/punk86.vfs/lib/Img1.4.14/pkgIndex.tcl

@@ -0,0 +1,154 @@
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded zlibtcl 1.2.13 [list load [file join $dir tcl9zlibtcl1213.dll]]
+} else {
+    package ifneeded zlibtcl 1.2.13 [list load [file join $dir zlibtcl1213.dll]]
+}
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded pngtcl 1.6.38 [list load [file join $dir tcl9pngtcl1638.dll]]
+} else {
+    package ifneeded pngtcl 1.6.38 [list load [file join $dir pngtcl1638.dll]]
+}
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded tifftcl 4.4.0 [list load [file join $dir tcl9tifftcl440.dll]]
+} else {
+    package ifneeded tifftcl 4.4.0 [list load [file join $dir tifftcl440.dll]]
+}
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded jpegtcl 9.5.0 [list load [file join $dir tcl9jpegtcl950.dll]]
+} else {
+    package ifneeded jpegtcl 9.5.0 [list load [file join $dir jpegtcl950.dll]]
+}
+# -*- tcl -*- Tcl package index file
+# --- --- --- Handcrafted, final generation by configure.
+
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded img::base 1.4.14 [list load [file join $dir tcl9tkimg1414.dll]]
+} else {
+    package ifneeded img::base 1.4.14 [list load [file join $dir tkimg1414.dll]]
+}
+# Compatibility hack. When asking for the old name of the package
+# then load all format handlers and base libraries provided by tkImg.
+# Actually we ask only for the format handlers, the required base
+# packages will be loaded automatically through the usual package
+# mechanism.
+
+# When reading images without specifying it's format (option -format),
+# the available formats are tried in reversed order as listed here.
+# Therefore file formats with some "magic" identifier, which can be
+# recognized safely, should be added at the end of this list.
+
+package ifneeded Img 1.4.14 {
+    package require img::window
+    package require img::tga
+    package require img::ico
+    package require img::pcx
+    package require img::sgi
+    package require img::sun
+    package require img::xbm
+    package require img::xpm
+    package require img::ps
+    package require img::jpeg
+    package require img::png
+    package require img::tiff
+    package require img::bmp
+    package require img::ppm
+    package require img::gif
+    package require img::pixmap
+    package provide Img 1.4.14
+}
+
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded img::bmp 1.4.14 [list load [file join $dir tcl9tkimgbmp1414.dll]]
+} else {
+    package ifneeded img::bmp 1.4.14 [list load [file join $dir tkimgbmp1414.dll]]
+}
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded img::gif 1.4.14 [list load [file join $dir tcl9tkimggif1414.dll]]
+} else {
+    package ifneeded img::gif 1.4.14 [list load [file join $dir tkimggif1414.dll]]
+}
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded img::ico 1.4.14 [list load [file join $dir tcl9tkimgico1414.dll]]
+} else {
+    package ifneeded img::ico 1.4.14 [list load [file join $dir tkimgico1414.dll]]
+}
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded img::jpeg 1.4.14 [list load [file join $dir tcl9tkimgjpeg1414.dll]]
+} else {
+    package ifneeded img::jpeg 1.4.14 [list load [file join $dir tkimgjpeg1414.dll]]
+}
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded img::pcx 1.4.14 [list load [file join $dir tcl9tkimgpcx1414.dll]]
+} else {
+    package ifneeded img::pcx 1.4.14 [list load [file join $dir tkimgpcx1414.dll]]
+}
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded img::pixmap 1.4.14 [list load [file join $dir tcl9tkimgpixmap1414.dll]]
+} else {
+    package ifneeded img::pixmap 1.4.14 [list load [file join $dir tkimgpixmap1414.dll]]
+}
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded img::png 1.4.14 [list load [file join $dir tcl9tkimgpng1414.dll]]
+} else {
+    package ifneeded img::png 1.4.14 [list load [file join $dir tkimgpng1414.dll]]
+}
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded img::ppm 1.4.14 [list load [file join $dir tcl9tkimgppm1414.dll]]
+} else {
+    package ifneeded img::ppm 1.4.14 [list load [file join $dir tkimgppm1414.dll]]
+}
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded img::ps 1.4.14 [list load [file join $dir tcl9tkimgps1414.dll]]
+} else {
+    package ifneeded img::ps 1.4.14 [list load [file join $dir tkimgps1414.dll]]
+}
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded img::sgi 1.4.14 [list load [file join $dir tcl9tkimgsgi1414.dll]]
+} else {
+    package ifneeded img::sgi 1.4.14 [list load [file join $dir tkimgsgi1414.dll]]
+}
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded img::sun 1.4.14 [list load [file join $dir tcl9tkimgsun1414.dll]]
+} else {
+    package ifneeded img::sun 1.4.14 [list load [file join $dir tkimgsun1414.dll]]
+}
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded img::tga 1.4.14 [list load [file join $dir tcl9tkimgtga1414.dll]]
+} else {
+    package ifneeded img::tga 1.4.14 [list load [file join $dir tkimgtga1414.dll]]
+}
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded img::tiff 1.4.14 [list load [file join $dir tcl9tkimgtiff1414.dll]]
+} else {
+    package ifneeded img::tiff 1.4.14 [list load [file join $dir tkimgtiff1414.dll]]
+}
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded img::window 1.4.14 [list load [file join $dir tcl9tkimgwindow1414.dll]]
+} else {
+    package ifneeded img::window 1.4.14 [list load [file join $dir tkimgwindow1414.dll]]
+}
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded img::xbm 1.4.14 [list load [file join $dir tcl9tkimgxbm1414.dll]]
+} else {
+    package ifneeded img::xbm 1.4.14 [list load [file join $dir tkimgxbm1414.dll]]
+}
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded img::xpm 1.4.14 [list load [file join $dir tcl9tkimgxpm1414.dll]]
+} else {
+    package ifneeded img::xpm 1.4.14 [list load [file join $dir tkimgxpm1414.dll]]
+}
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded img::dted 1.4.14 [list load [file join $dir tcl9tkimgdted1414.dll]]
+} else {
+    package ifneeded img::dted 1.4.14 [list load [file join $dir tkimgdted1414.dll]]
+}
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded img::raw 1.4.14 [list load [file join $dir tcl9tkimgraw1414.dll]]
+} else {
+    package ifneeded img::raw 1.4.14 [list load [file join $dir tkimgraw1414.dll]]
+}
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded img::flir 1.4.14 [list load [file join $dir tcl9tkimgflir1414.dll]]
+} else {
+    package ifneeded img::flir 1.4.14 [list load [file join $dir tkimgflir1414.dll]]
+}

src/punk86.vfs/lib/app-punk/repl.tcl

@@ -1109,9 +1109,8 @@ proc repl::repl_handler {inputchan prompt_config} {
     }
     fileevent $inputchan readable [list [namespace current]::repl_handler $inputchan $prompt_config]
 }
-repl::start stdin
-
-exit 0
+#repl::start stdin
+#exit 0
 
 #repl::start $program_read_stdin_pipe
 

src/punk86.vfs/lib/app-shellspy/shellspy.tcl

@@ -45,12 +45,22 @@ set arg1 [lindex $::argv 0]
 if {[file extension $arg1] in [list .tCl]} {
     set ::argv [lrange $::argv 1 end]
     set ::argc [llength $::argv]
-    set scriptfile [file normalize $arg1]
-    if {![file exists $scriptfile]} {
+ 
+    set exedir [file dirname [info nameofexecutable]]
+    set libroot [file join $exedir scriptlib] 
+    set scriptname $arg1
+    if {[string match lib::* $scriptname]} {
+        set scriptname [string map [list "lib::" "" "::" "/"] $scriptname]
+        set scriptpath $libroot/$scriptname
+    } else {
+        set scriptpath [file normalize $scriptname]
+    }
+
+    if {![file exists $scriptpath]} {
         #try the lowercase version (extension lowercased only) so that file doesn't have to be renamed to use alternate dispatch
-        set scriptfile [file rootname $scriptfile][string tolower [file extension $scriptfile]]
+        set scriptpath [file rootname $scriptpath][string tolower [file extension $scriptpath]]
     }
-    source [$scriptfile]
+    source $scriptpath
 
     #package require app-punk
 
@@ -502,8 +512,10 @@ namespace eval shellspy {
                 error "bad scriptpath '$scriptpath'"
             }
         }
+        set modulesdir $exedir/modules
 
-        set script [string map [list %a% $args %s% $scriptpath] {
+        set script [string map [list %a% $args %s% $scriptpath %m% $modulesdir] {
+::tcl::tm::add %m%
 set scriptname %s%
 set ::argv [list %a%]
 set ::argc [llength $::argv]
@@ -511,15 +523,16 @@ source [file normalize $scriptname]
     
         }]
 
-        set repl_line "package require app-punk\n"
+        set repl_lines "package require app-punk\n"
+        append repl_lines "repl::start stdin\n"
 
         if {$replwhen eq "repl_first"} {
             #we need to cooperate with the repl to get the script to run on exit
             namespace eval ::repl {}
             set ::repl::post_script $script
-            set script "$repl_line"
+            set script "$repl_lines"
         } elseif {$replwhen eq "repl_last"} {
-            append script $repl_line
+            append script $repl_lines
         } else {
             #just the script
         }
@@ -778,8 +791,8 @@ source [file normalize $scriptname]
         after 200
         
     }
-    
-    exit 0
+    #if we call exit - package require Tk scripts will exit prematurely 
+    #exit 0
 }
 
 }

src/punk86.vfs/lib/imgjp20.1/pkgIndex.tcl

@@ -0,0 +1,2 @@
+package ifneeded imgjp2 0.1 \
+    [list load [file join $dir imgjp201.dll] imgjp2]

src/punk86.vfs/lib/imgtools0.3/pkgIndex.tcl

@@ -0,0 +1,5 @@
+#
+# Tcl package index file
+#
+package ifneeded imgtools 0.3 \
+    [list load [file join $dir imgtools03.dll] imgtools]

src/punk86.vfs/main.tcl

@@ -5,5 +5,6 @@
     package require app-shellspy
   } else {
     package require app-punk
+    repl::start stdin
   }