aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorgwern <gwern@gwern.net>2014-06-01 04:50:19 +0200
committergwern <gwern@gwern.net>2014-06-01 04:50:19 +0200
commitf08d7673e8bc7f18e97952ff025a31c34e143e40 (patch)
tree66375b7e5ec0ff80f23fdf92d0d4fa20be079fd6
parentab42feffb78b2ed72f168341648d4f3b3118e390 (diff)
downloadXMonadContrib-f08d7673e8bc7f18e97952ff025a31c34e143e40.tar.gz
XMonadContrib-f08d7673e8bc7f18e97952ff025a31c34e143e40.tar.xz
XMonadContrib-f08d7673e8bc7f18e97952ff025a31c34e143e40.zip
XSelection: getSelection: fix connection exhaustion bug (issue #573); include warning
Ignore-this: add21190fc07338b243c2241cc746119 darcs-hash:20140601025019-25739-c68993f1e89524d9c6201a7c882fedbc8b106a41.gz
-rw-r--r--XMonad/Util/XSelection.hs14
1 files changed, 10 insertions, 4 deletions
diff --git a/XMonad/Util/XSelection.hs b/XMonad/Util/XSelection.hs
index 5ab06de..f2f3a88 100644
--- a/XMonad/Util/XSelection.hs
+++ b/XMonad/Util/XSelection.hs
@@ -46,6 +46,10 @@ import Codec.Binary.UTF8.String (decode)
-- | Returns a String corresponding to the current mouse selection in X;
-- if there is none, an empty string is returned.
+--
+-- WARNING: this function is fundamentally implemented incorrectly and may, among other possible failure modes,
+-- deadlock or crash. For details, see <http://code.google.com/p/xmonad/issues/detail?id=573>.
+-- (These errors are generally very rare in practice, but still exist.)
getSelection :: MonadIO m => m String
getSelection = io $ do
dpy <- openDisplay ""
@@ -63,10 +67,12 @@ getSelection = io $ do
allocaXEvent $ \e -> do
nextEvent dpy e
ev <- getEvent e
- if ev_event_type ev == selectionNotify
- then do res <- getWindowProperty8 dpy clp win
- return $ decode . map fromIntegral . fromMaybe [] $ res
- else destroyWindow dpy win >> return ""
+ result <- if ev_event_type ev == selectionNotify
+ then do res <- getWindowProperty8 dpy clp win
+ return $ decode . map fromIntegral . fromMaybe [] $ res
+ else destroyWindow dpy win >> return ""
+ closeDisplay dpy
+ return result
{- | A wrapper around 'getSelection'. Makes it convenient to run a program with the current selection as an argument.
This is convenient for handling URLs, in particular. For example, in your Config.hs you could bind a key to