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