Clojurians Log v2

(ns chucklehead.whisper
  (:require
   [clojure.core.async :as async]
   [clojure.core.async.flow :as flow])
  (:import
   (com.sun.jna Pointer)
   (com.sun.jna.platform.win32
    Kernel32
    User32
    WinDef$HWND
    WinDef$LPARAM
    WinDef$LRESULT
    WinUser$HHOOK
    WinUser$LowLevelKeyboardProc
    WinUser$MSG)
   (java.awt.event KeyEvent)))

(set! *warn-on-reflection* true)

(def keyboard-callback-handler (atom nil))

(defn- install-hotkey-hook!
  "Starts a Win32 message loop and installs a low-level keyboard hook to listen 
   for the specified key combination. The provided channel is notified when the 
   combination is pressed or released.
   
   Returns a function that will uninstall the hook and stop the message loop."
  [modifier-keys key ch]
  (let [NULL (WinUser$HHOOK.)
        ZERO (int 0)
        stop (atom false)
        current-module (.GetModuleHandle Kernel32/INSTANCE nil)
        layout (.GetKeyboardLayout User32/INSTANCE ZERO)
        modifiers (set modifier-keys)
        state (volatile! {:pressed-modifiers #{}
                          :pressed-other #{}
                          :active false})
        handler-proc (reify WinUser$LowLevelKeyboardProc
                       (callback [_ nCode wParam lParam]
                         (let [next-hook (let [lParam (-> lParam .getPointer Pointer/nativeValue WinDef$LPARAM.)]
                                           #(.CallNextHookEx User32/INSTANCE NULL nCode wParam lParam))
                               pressed-vk (.MapVirtualKeyEx User32/INSTANCE (.-scanCode lParam) User32/MAPVK_VSC_TO_VK layout)
                               {:keys [pressed-modifiers pressed-other active]} @state
                               wParam-val (.intValue wParam)]
                           (try
                             (when (zero? nCode)
                               (if (#{User32/WM_KEYDOWN User32/WM_SYSKEYDOWN} wParam-val)
                                 (if (modifiers pressed-vk)
                                   (vswap! state update :pressed-modifiers conj pressed-vk)
                                   (when (and (= key pressed-vk)
                                              (= modifiers pressed-modifiers)
                                              (empty? pressed-other)
                                              (not active))
                                     (vswap! state assoc :active true)
                                     (async/put! ch :pressed)))
                                 (if (or (= key pressed-vk) (modifiers pressed-vk))
                                   (do
                                     (vswap! state #(-> %
                                                        (assoc :active false)
                                                        (update :pressed-modifiers disj pressed-vk)))
                                     (when active
                                       (async/put! ch :released)))
                                   (vswap! state update :pressed-other disj pressed-vk))))
                             (catch Exception e
                               (println "Handler exception:\n" e)))
                           (next-hook))))
        _ (reset! keyboard-callback-handler handler-proc)
        msg-loop (future
                   (try
                     (let [NULL (WinDef$HWND. Pointer/NULL)
                           MSG (WinUser$MSG.)]
                       (.PeekMessage User32/INSTANCE MSG NULL ZERO ZERO ZERO)
                       (let [hook (.SetWindowsHookEx User32/INSTANCE User32/WH_KEYBOARD_LL handler-proc current-module ZERO)]
                         (when  (not= Pointer/NULL (.getPointer hook))
                           (loop [result (.GetMessage User32/INSTANCE MSG NULL ZERO ZERO)
                                  stop? @stop]
                             (when-not (or stop? (neg-int? result))
                               (.TranslateMessage User32/INSTANCE MSG)
                               (.DispatchMessage User32/INSTANCE MSG)
                               (recur (.GetMessage User32/INSTANCE MSG NULL ZERO ZERO) @stop)))
                           (.UnhookWindowsHookEx User32/INSTANCE hook))))
                     (catch Exception e
                       (println "Message loop exception:\n" e)))
                   (WinDef$LRESULT. ZERO))]

    ;; Return stopping fn
    (fn []
      (reset! stop true)
      (reset! keyboard-callback-handler nil)
      (deref msg-loop 2000 :timed-out))))

(defn hotkey-source
  ([] {:params {:modifiers "Set of modifier keys for the hotkey"
                :key "Base key for the hotkey"}
       :outs {:out "Output channel for key presses"}})
  ([args] (assoc-in args [::flow/in-ports :pressed] (async/chan 1)))
  ([{:keys [key modifiers uninstall-hook ::flow/in-ports] :as state} transition]
   (try
     (case transition
       ::flow/resume
       (let [uninstall-hook (#'install-hotkey-hook! modifiers key (:pressed in-ports))]
         (println "Flow resumed. Installed hotkey hook.")
         (assoc state :uninstall-hook uninstall-hook))
       (::flow/pause ::flow/stop)
       (do
         (println "Flow paused or stopped.")
         (when uninstall-hook
           (uninstall-hook)
           (dissoc state :uninstall-hook))))
     (catch Exception e
       (println "Hotkey flow exception:\n" e)
       state)))
  ([state in msg] [state (when (= :pressed in) {:out [msg]})]))

(defn audio-source
  ([] {:ins {:key-in "Input channel to receive record keypress events"}})
  ([args] (assoc args ::flow/in-ports {:audio-in (async/chan (async/sliding-buffer 10))}))
  ([{:keys [::flow/in-ports] :as state} transition]
   (case transition
     ::flow/resume
     (do
       (println "Flow resumed. Waiting to record...")
       state)
     (::flow/pause ::flow/stop)
     (do
       (println "Stopping flow...")
       state)))
  ([state in msg]
   (case in
     :key-in (case msg
                   :pressed (do
                              (println "Starting recording...")
                              [state nil])
                   :released (do
                               (println "Stopping recording...")
                               [state nil]))
     :audio-in [state nil])))


(def recorder-flow
  {:procs {:hotkey-proc {:proc (flow/process #'hotkey-source)
                         :args {:key KeyEvent/VK_B
                                :modifiers #{KeyEvent/VK_ALT}}}
           :recorder-proc {:proc (flow/process #'audio-source)}}
   :conns [[[:hotkey-proc :out] [:recorder-proc :key-in]]]})

(comment
  (def record-test (flow/create-flow recorder-flow))

  (flow/start record-test)
  
  (flow/resume record-test)
  (flow/pause record-test)
  (flow/stop record-test))

Previously this would sometimes work for several minutes, sometimes only for a few seconds, and then just stop. On rare occasions, it would log a JNA: callback object has been garbage collected message in a console I wasn't looking at, which is what led me to stick the handler in an atom. Since then, it appears to have been stable overnight and through a few suspend/resume cycles, but this approach feels a little off to me for some reason.

The only other approach that IMO could make sense would be to hold onto a reference to the callback in the cleanup function; however that makes leaking the cleanup extra dangerous.

https://github.com/java-native-access/jna/blob/master/www/CallbacksAndClosures.md "If your callback needs to live beyond the method invocation where it is used, make sure you keep a reference to it or the native code will call back to an empty stub after the callback object is garbage collected."

I was just doing the same thing this past week for a JNA callback (in that case, to redirect logging to clojure.tools.logging) — atom was the best I came up with too

For your example, I would recommend returning a reified instance of java.io.Closeable and java.io.AutoCloseable. This would let your hotkey process to interoperate generically with flows and code that works with closeable objects. For example:

(with-open [hook-ref (install-hotkey-hook! modifiers key port)]
  ... do stuff
  )

thanks everyone...just finished refactoring to keep a reference in the cleanup function which is stored in the flow state, and that seems to work. But I like the idea of being able to use it with with-open

ended up with:

(defn- last-error [msg]
  (let [err (Native/getLastError)]
    (ex-info msg {::last-error err ::error-msg (Kernel32Util/formatMessageFromLastErrorCode err)})))

(defn- install-hotkey-hook!
  "Starts a Win32 message loop and installs a low-level keyboard hook to listen 
   for the specified key combination. The provided channel is notified when the 
   combination is pressed or released.
   
   Returns a function that will uninstall the hook and stop the message loop."
  [modifier-keys key ch]
  (let [current-module (.GetModuleHandle Kernel32/INSTANCE nil)
        layout (.GetKeyboardLayout User32/INSTANCE 0)
        modifiers (set modifier-keys)
        state (volatile! {:pressed-modifiers #{}
                          :pressed-other #{}
                          :active false})
        handler-proc (reify WinUser$LowLevelKeyboardProc
                       (callback [_ nCode wParam lParam]
                         (let [wParam-val (.intValue wParam)
                               pressed-vk (.MapVirtualKeyEx User32/INSTANCE (.-scanCode lParam) User32/MAPVK_VSC_TO_VK layout)
                               {:keys [pressed-modifiers pressed-other active]} @state]
                           (try
                             (when (zero? nCode)
                               (if (#{User32/WM_KEYDOWN User32/WM_SYSKEYDOWN} wParam-val)
                                 (if (modifiers pressed-vk)
                                   (vswap! state update :pressed-modifiers conj pressed-vk)
                                   (when (and (= key pressed-vk)
                                              (= modifiers pressed-modifiers)
                                              (empty? pressed-other)
                                              (not active))
                                     (vswap! state assoc :active true)
                                     (async/put! ch :pressed)))
                                 (if (or (= key pressed-vk) (modifiers pressed-vk))
                                   (do
                                     (vswap! state #(-> %
                                                        (assoc :active false)
                                                        (update :pressed-modifiers disj pressed-vk)))
                                     (when active
                                       (async/put! ch :released)))
                                   (vswap! state update :pressed-other disj pressed-vk))))
                             (catch Exception e
                               (println "Handler exception:\n" e)))
                           (.CallNextHookEx User32/INSTANCE nil nCode wParam (-> lParam .getPointer Pointer/nativeValue WinDef$LPARAM.)))))
        hook-prom (promise)
        msg-loop (future
                   (let [hook (.SetWindowsHookEx User32/INSTANCE User32/WH_KEYBOARD_LL handler-proc current-module 0)]
                     (if (= Pointer/NULL (.getPointer hook))
                       (deliver hook-prom (last-error "Failed to register hook."))
                       (try
                         (deliver hook-prom [(.GetCurrentThreadId Kernel32/INSTANCE) hook])
                         (let [MSG (WinUser$MSG.)]
                           (.PeekMessage User32/INSTANCE MSG nil 0 0 0)
                           (loop [result (.GetMessage User32/INSTANCE MSG nil 0 0)]
                             (when (nat-int? result)
                               (.TranslateMessage User32/INSTANCE MSG)
                               (.DispatchMessage User32/INSTANCE MSG)
                               (when (pos-int? result)
                                 (recur (.GetMessage User32/INSTANCE MSG nil 0 0))))))
                         (WinDef$LRESULT. 0)
                         (catch Exception e
                           (println "Message loop exception:\n" e))))))
        result @hook-prom]
    (if (instance? clojure.lang.ExceptionInfo result)
      (throw result)
      ;; stopping fn holds reference to JNA callback
      (reify java.lang.AutoCloseable
        (close [_]
          (let [_handler-ref handler-proc
                [^int thread-id ^WinUser$HHOOK hook] result]
            (when-not (.UnhookWindowsHookEx User32/INSTANCE hook)
              (throw (last-error "Failed to unregister hook.")))
            (when (zero? (.PostThreadMessage User32/INSTANCE thread-id User32/WM_QUIT nil nil))
              (throw (last-error "Failed to stop message loop.")))
            (deref msg-loop 5000 ::timed-out)))))))

(defn hotkey-source
  ([] {:params {:modifiers "Set of modifier keys for the hotkey"
                :key "Base key for the hotkey"}
       :outs {:out "Output channel for key presses"}})
  ([args] (assoc-in args [::flow/in-ports :pressed] (async/chan 1)))
  ([{:keys [key modifiers hook ::flow/in-ports] :as state} transition]
   (case transition
     ::flow/resume
     (do
       (println "Hotkey flow resumed. Installing hook.")
       (assoc state :hook (#'install-hotkey-hook! modifiers key (:pressed in-ports))))
     (::flow/pause ::flow/stop)
     (do
       (println "Hotkey flow paused or stopped.")
       (when hook
         (.close ^java.lang.AutoCloseable hook)
         (dissoc state :hook)))))
  ([state in msg] [state (when (= :pressed in) {:out [msg]})]))