Changeset 14241

Timestamp:

Sep 8, 2010, 7:31:52 PM (14 years ago)

Author:

R. Matthew Emerson

Message:

Add functions caps-lock-key-p, control-key-p, command-key-p,
option-key-p, and alt-key-p.

Add Windows versions for a few of them.

These probably belong elsewhere; there's not Cocoa-specific.

File:

• trunk/source/cocoa-ide/cocoa-utils.lisp (modified) (1 diff)

trunk/source/cocoa-ide/cocoa-utils.lisp

@@ -411 +411 @@
     (>= (%get-long p) #x1050)))
 
+
+;;; This stuff is not Cocoa-specific.
+
+#+windows-target
+(progn
+(defun caps-lock-key-p ()
+  ;; I thought this might work, but it seems to behave oddly.
+  ;;(logbitp 0 (#_GetAsyncKeyState #$VK_CAPITAL))
+  nil)
+
+(defun shift-key-p ()
+  (logbitp 15 (#_GetAsyncKeyState #$VK_SHIFT)))
+
+(defun control-key-p ()
+  (logbitp 15 (#_GetAsyncKeyState #$VK_CONTROL)))
+
+(defun command-key-p ()
+  nil)
+
+(defun option-key-p ()
+  (logbitp 15 (#_GetAsyncKeyState #$VK_MENU)))
+
+(defun alt-key-p ()
+  (option-key-p))
+)
+
+#+darwin-target
+(progn
+
 ;; This works even if an event loop is not running.
-#-cocotron
-(defun shift-key-p ()
+(defun cgevent-flags-test (mask)
+  (require-type mask '(unsigned-byte 64))
   (let* ((event (#_CGEventCreate +null-ptr+))
          (flags (#_CGEventGetFlags event)))
     (prog1
-        (logtest flags #$kCGEventFlagMaskShift)
+        (logtest flags mask)
       (#_CFRelease event))))
 
-#+cocotron
+(defun caps-lock-key-p ()
+  (cgevent-flags-test #$kCGEventFlagMaskAlphaShift))
+
 (defun shift-key-p ()
-  nil)
+  (cgevent-flags-test #$kCGEventFlagMaskShift))
+
+(defun control-key-p ()
+  (cgevent-flags-test #$kCGEventFlagMaskControl))
+
+(defun command-key-p ()
+  (cgevent-flags-test #$kCGEventFlagMaskCommand))
+
+(defun option-key-p ()
+  (cgevent-flags-test #$kCGEventFlagMaskAlternate))
+
+(defun alt-key-p ()
+  (option-key-p))
+)