punkshell/src/modules/punkapp-0.1.tm

#utilities for punk apps to call

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"
        }
    }
    
}