Archive version of: window-util.r ... version: 2 ... maxt 19-Mar-2010

REBOL [
	Title: "Method to set Rebol console title."
	Author: "Maxime Tremblay, idea comes from %no-rebol-in-title-bar.r script by Nick Antonaccio"
	Version: 1.0.0
	Date: 19/03/2010
	file: %window-util.r
	purpose: {
            Used to set the Rebol console's window title.
            Include a method to get the current windows handle.
            Work only in windows.
        }
]

window-util: context [
    
    user32.dll: load/library %user32.dll
    msvcrt.dll: load/library %msvcrt.dll
    
    GetDesktopWindow: make routine! [return: [integer!]] user32.dll "GetDesktopWindow"
    GetWindow: make routine! [hWnd [integer!] uCmd [integer!] return: [integer!]] user32.dll "GetWindow"
    GetWindowThreadProcessId: make routine! [hWnd [integer!] pid [struct! [id [integer!]]] return: [integer!]] user32.dll "GetWindowThreadProcessId"
    SetWindowText: make routine! [hwnd [int] text [string!] return: [int]] user32.dll "SetWindowTextA"
    getpid: make routine! [return: [long]] msvcrt.dll "_getpid"
    
    get-current-window: func [/local cw curpid wpid curwin] [
        wpid: make struct! [wpid [integer!]] none
        
        ; get current process
        curpid: getpid
        
        ; get desktop window (uppermost window)
        cw: getwindow getdesktopwindow 5
        
        ; find the first window for the current process 
        ; an infitine loop prevention may be useful here
        while [not equal? cw 0] [
            cw: getwindow cw 2
            getwindowthreadprocessid cw wpid
            if equal? wpid/wpid curpid [
                ; now we must find the top level window
                while [not equal? cw 0] [
                    curwin: cw
                    cw: getwindow cw 4
                ]
                break
             ]
        ]
        curwin
    ]
    
    set-title: func [title-text /local curwin] [
        ; this probe is there to ensure that the window is displayed when setting the title
        probe title-text
        if curwin: get-current-window [
            SetWindowText curwin title-text
        ]
    ]
]