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