Merge pull request #404 from geekosaur/forever-away

attempt to work around the join point bug (#389)
This commit is contained in:
Tony Zorman 2022-08-04 08:48:43 +02:00 committed by GitHub
commit a13a1dcee8
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 12 additions and 2 deletions

View File

@ -13,6 +13,13 @@
* Fixed border color of windows with alpha channel. Now all windows have the * Fixed border color of windows with alpha channel. Now all windows have the
same opaque border color. same opaque border color.
* Change the main loop to try to avoid [GHC bug 21708] on systems
running GHC 9.2 up to version 9.2.3. The issue has been fixed in
[GHC 9.2.4] and all later releases.
[GHC bug 21708]: https://gitlab.haskell.org/ghc/ghc/-/issues/21708
[GHC 9.2.4]: https://discourse.haskell.org/t/ghc-9-2-4-released/4851
## 0.17.0 (October 27, 2021) ## 0.17.0 (October 27, 2021)
### Enhancements ### Enhancements

View File

@ -267,10 +267,11 @@ launch initxmc drs = do
userCode $ startupHook initxmc userCode $ startupHook initxmc
rrData <- io $ xrrQueryExtension dpy rrData <- io $ xrrQueryExtension dpy
let rrUpdate = when (isJust rrData) . void . xrrUpdateConfiguration
-- main loop, for all you HOF/recursion fans out there. -- main loop, for all you HOF/recursion fans out there.
forever $ prehandle =<< io (nextEvent dpy e >> rrUpdate e >> getEvent e) -- forever $ prehandle =<< io (nextEvent dpy e >> rrUpdate e >> getEvent e)
-- sadly, 9.2.{1,2,3} join points mishandle the above and trash the heap (see #389)
mainLoop dpy e rrData
return () return ()
where where
@ -281,6 +282,8 @@ launch initxmc drs = do
in local (\c -> c { mousePosition = mouse, currentEvent = Just e }) (handleWithHook e) in local (\c -> c { mousePosition = mouse, currentEvent = Just e }) (handleWithHook e)
evs = [ keyPress, keyRelease, enterNotify, leaveNotify evs = [ keyPress, keyRelease, enterNotify, leaveNotify
, buttonPress, buttonRelease] , buttonPress, buttonRelease]
rrUpdate e r = when (isJust r) (void (xrrUpdateConfiguration e))
mainLoop d e r = io (nextEvent d e >> rrUpdate e r >> getEvent e) >>= prehandle >> mainLoop d e r
-- | Runs handleEventHook from the configuration and runs the default handler -- | Runs handleEventHook from the configuration and runs the default handler