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 {
    variable result
    variable waiting "no" 
    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 make_toplevel_next {prefix} {
        set top [get_toplevel_next $prefix]
        return [toplevel $top]
    }
    #possible race condition if multiple calls made without actually creating the toplevel, or gap if highest existing closed in the meantime
    #todo - reserve_toplevel_next ? keep list of toplevels considered 'allocated' even if never created or already destroyed? what usecase?
    #can call wm withdraw to to reserve newly created toplevel. To stop re-use of existing names after destruction would require a list or at least a record of highest created for each prefix
    proc get_toplevel_next {prefix} {
        set base [string trim $prefix .] ;# .myapp -> myapp  .myapp.somewindow  -> myapp.somewindow   . -> ""
       


    }
    proc exit {{toplevel ""}} {
        variable waiting
        variable result
        variable default_result
        set toplevels [get_toplevels]
        if {[string length $toplevel]} {
            set wposn [lsearch $toplevels $toplevel]
            if {$wposn > 0} {
                destroy $toplevel
            }
        } else {
            #review 
            if {[package provide punk::repl::codethread] ne "" &&  [punk::repl::codethread::is_running]} {
                puts stderr "punkapp::exit called without toplevel - showing console"
                show_console
                return 0
            } else {
                puts stderr "punkapp::exit called without toplevel - exiting"
                if {$waiting ne "no"} {
                    if {[info exists result(shell)]} {
                        set temp [set result(shell)]
                        unset result(shell)
                        set waiting $temp
                    } else {
                        set waiting ""
                    }
                } else {
                    ::exit
                }
            }
        }
        
        set controllable [get_user_controllable_toplevels]
        if {![llength $controllable]} {
            if {[package provide punk::repl::codethread] ne "" &&  [punk::repl::codethread::is_running]} {
                show_console
            } else {
                if {$waiting ne "no"} {
                    if {[info exists result(shell)]} {
                        set temp [set result(shell)]
                        unset result(shell)
                        set waiting $temp
                    } elseif {[info exists result($toplevel)]} {
                        set temp [set result($toplevel)]
                        unset result($toplevel)
                        set waiting $temp
                    } elseif {[info exists default_result]} {
                        set temp $default_result
                        unset default_result
                        set waiting $temp
                    } else {
                        set waiting ""
                    }
                } else {
                    ::exit
                }
            }
        }
    }
    proc close_window {toplevel} {
        wm withdraw $toplevel
        if {![llength [get_user_controllable_toplevels]]} {
            punkapp::exit $toplevel
        }
        destroy $toplevel
    }
    proc wait {args} {
        variable waiting
        variable default_result
        if {[dict exists $args -defaultresult]} {
            set default_result [dict get $args -defaultresult]
        }
        foreach t [punkapp::get_toplevels] {
            if {[wm protocol $t WM_DELETE_WINDOW] eq ""} {
                wm protocol $t WM_DELETE_WINDOW [list punkapp::close_window $t]
            }
        }
        if {[package provide punk::repl::codethread] ne "" &&  [punk::repl::codethread::is_running]} {
            puts stderr "repl eventloop seems to be running - punkapp::wait not required"
        } else {
            if {$waiting eq "no"} {
                set waiting "waiting"
                vwait ::punkapp::waiting
                return $::punkapp::waiting
            }
        }
    } 

    #A window can be 'visible' according to this - but underneath other windows etc
    #REVIEW - change name?
    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} {
                lappend 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 opts [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]
        foreach {k v} $args {
            switch -- $k {
                -force {
                    dict set opts $k $v
                }
                default {
                    error "Unrecognised options '$k'  known options: [dict keys $opts]"
                }
            }
        }
        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"} {
            #hide won't work for certain consoles cush as conemu,wezterm - and doesn't really make sense for tabbed windows anyway.
            #It would be nice if we could tell the console window to hide just the relevant tab - or the whole window if only one tab present - but this is unlikely to be possible in any standard way.
            #an ordinary cmd.exe or pwsh.exe or powershell.exe window can be hidden ok though.
            #(but with wezterm - process is cmd.exe - but it has style popup and can't be hidden with a twapi::hide_window call)
            package require twapi
            set h [twapi::get_console_window]
            set pid [twapi::get_window_process $h]
            set pinfo [twapi::get_process_info $pid -name] 
            set pname [dict get $pinfo -name]
            set wstyle [twapi::get_window_style $h]
            #tclkitsh/tclsh?
            if {($pname in [list cmd.exe pwsh.exe powershell.exe] || [string match punk*.exe $pname]) && "popup" ni $wstyle} {
                twapi::hide_window $h 
                return 1
            } else {
                puts stderr "punkapp::hide_console unable to hide this type of console window"
                return 0
            }
        } 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"
        }
    }
    
}