Changeset 14241


Ignore:
Timestamp:
Sep 9, 2010, 2:31:52 AM (9 years ago)
Author:
rme
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:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/cocoa-utils.lisp

    r14225 r14241  
    411411    (>= (%get-long p) #x1050)))
    412412
     413
     414;;; This stuff is not Cocoa-specific.
     415
     416#+windows-target
     417(progn
     418(defun caps-lock-key-p ()
     419  ;; I thought this might work, but it seems to behave oddly.
     420  ;;(logbitp 0 (#_GetAsyncKeyState #$VK_CAPITAL))
     421  nil)
     422
     423(defun shift-key-p ()
     424  (logbitp 15 (#_GetAsyncKeyState #$VK_SHIFT)))
     425
     426(defun control-key-p ()
     427  (logbitp 15 (#_GetAsyncKeyState #$VK_CONTROL)))
     428
     429(defun command-key-p ()
     430  nil)
     431
     432(defun option-key-p ()
     433  (logbitp 15 (#_GetAsyncKeyState #$VK_MENU)))
     434
     435(defun alt-key-p ()
     436  (option-key-p))
     437)
     438
     439#+darwin-target
     440(progn
     441
    413442;; This works even if an event loop is not running.
    414 #-cocotron
    415 (defun shift-key-p ()
     443(defun cgevent-flags-test (mask)
     444  (require-type mask '(unsigned-byte 64))
    416445  (let* ((event (#_CGEventCreate +null-ptr+))
    417446         (flags (#_CGEventGetFlags event)))
    418447    (prog1
    419         (logtest flags #$kCGEventFlagMaskShift)
     448        (logtest flags mask)
    420449      (#_CFRelease event))))
    421450
    422 #+cocotron
     451(defun caps-lock-key-p ()
     452  (cgevent-flags-test #$kCGEventFlagMaskAlphaShift))
     453
    423454(defun shift-key-p ()
    424   nil)
     455  (cgevent-flags-test #$kCGEventFlagMaskShift))
     456
     457(defun control-key-p ()
     458  (cgevent-flags-test #$kCGEventFlagMaskControl))
     459
     460(defun command-key-p ()
     461  (cgevent-flags-test #$kCGEventFlagMaskCommand))
     462
     463(defun option-key-p ()
     464  (cgevent-flags-test #$kCGEventFlagMaskAlternate))
     465
     466(defun alt-key-p ()
     467  (option-key-p))
     468)
Note: See TracChangeset for help on using the changeset viewer.