1#
2# Copyright (c) 2012 Ashok P. Nadkarni
3# All rights reserved.
4#
5# See the file LICENSE for license
6
7# Contains common windowing and notification infrastructure
8
9namespace eval twapi {
10    variable null_hwin ""
11
12    # Windows messages that are directly accessible from script. These
13    # are handled by the default notifications window and passed to
14    # the twapi::_script_wm_handler. These messages must be in the
15    # range (1056 = 1024+32) - (1024+32+31) (see twapi_wm.h)
16    variable _wm_script_msgs
17    array set _wm_script_msgs {
18        TASKBAR_RESTART      1031
19        NOTIFY_ICON_CALLBACK 1056
20    }
21    proc _get_script_wm {tok} {
22        variable _wm_script_msgs
23        return $_wm_script_msgs($tok)
24    }
25}
26
27# Backward compatibility aliases
28interp alias {} twapi::GetWindowLong {} twapi::GetWindowLongPtr
29interp alias {} twapi::SetWindowLong {} twapi::SetWindowLongPtr
30
31# Return the long value at the given index
32# This is a raw function, and should generally be used only to get
33# non-system defined indices
34proc twapi::get_window_long {hwin index} {
35    return [GetWindowLongPtr $hwin $index]
36}
37
38# Set the long value at the given index and return the previous value
39# This is a raw function, and should generally be used only to get
40# non-system defined indices
41proc twapi::set_window_long {hwin index val} {
42    set oldval [SetWindowLongPtr $hwin $index $val]
43}
44
45# Set the user data associated with a window. Returns the previous value
46proc twapi::set_window_userdata {hwin val} {
47    # GWL_USERDATA -> -21
48    return [SetWindowLongPtr $hwin -21 $val]
49}
50
51# Attaches to the thread queue of the thread owning $hwin and executes
52# script in the caller's scope
53proc twapi::_attach_hwin_and_eval {hwin script} {
54    set me [GetCurrentThreadId]
55    set hwin_tid [lindex [GetWindowThreadProcessId $hwin] 0]
56    if {$hwin_tid == 0} {
57        error "Window $hwin does not exist or could not get its thread owner"
58    }
59
60    # Cannot (and no need to) attach to oneself so just exec script directly
61    if {$me == $hwin_tid} {
62        return [uplevel 1 $script]
63    }
64
65    trap {
66        if {![AttachThreadInput $me $hwin_tid 1]} {
67            error "Could not attach to thread input for window $hwin"
68        }
69        set result [uplevel 1 $script]
70    } finally {
71        AttachThreadInput $me $hwin_tid 0
72    }
73
74    return $result
75}
76
77proc twapi::_register_script_wm_handler {msg cmdprefix {overwrite 0}} {
78    variable _wm_registrations
79
80    # Ensure notification window exists
81    twapi::Twapi_GetNotificationWindow
82
83    # The incr ensures decimal format
84    # The lrange ensure proper list format
85    if {$overwrite} {
86        set _wm_registrations([incr msg 0]) [list [lrange $cmdprefix 0 end]]
87    } else {
88        lappend _wm_registrations([incr msg 0]) [lrange $cmdprefix 0 end]
89    }
90}
91
92proc twapi::_unregister_script_wm_handler {msg cmdprefix} {
93    variable _wm_registrations
94
95    # The incr ensures decimal format
96    incr msg 0
97    # The lrange ensure proper list format
98    if {[info exists _wm_registrations($msg)]} {
99        set _wm_registrations($msg) [lsearch -exact -inline -not -all $_wm_registrations($msg) [lrange $cmdprefix 0 end]]
100    }
101}
102
103# Handles notifications from the common window for script level windows
104# messages (see win.c)
105proc twapi::_script_wm_handler {msg wparam lparam msgpos ticks} {
106    variable _wm_registrations
107
108    set code 0
109    if {[info exists _wm_registrations($msg)]} {
110        foreach handler $_wm_registrations($msg) {
111            set code [catch {uplevel #0 [linsert $handler end $msg $wparam $lparam $msgpos $ticks]} msg]
112            switch -exact -- $code {
113                1 {
114                    # TBD - should remaining handlers be called even on error ?
115                    after 0 [list error $msg $::errorInfo $::errorCode]
116                    break
117                }
118                3 {
119                    break;      # Ignore remaining handlers
120                }
121                default {
122                    # Keep going
123                }
124            }
125        }
126    } else {
127        # TBD - debuglog - no handler for $msg
128    }
129
130    return
131}
132