1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
{-# LANGUAGE CPP #-}
{- |
Module : XMonad.Util.XSelection
Copyright : (C) 2007 Andrea Rossato, Matthew Sackman
License : BSD3
Maintainer : Gwern Branwen <gwern0@gmail.com>
Stability : unstable
Portability : unportable
A module for accessing and manipulating X Window's mouse selection (the buffer used in copy and pasting).
'getSelection' and 'putSelection' are adaptations of Hxsel.hs and Hxput.hs from the XMonad-utils, available:
> $ darcs get <http://gorgias.mine.nu/repos/xmonad-utils>
-}
module XMonad.Util.XSelection ( -- * Usage
-- $usage
getSelection,
promptSelection,
safePromptSelection,
transformPromptSelection,
transformSafePromptSelection,
putSelection) where
import Control.Concurrent (forkIO)
import Control.Exception as E (catch)
import Control.Monad(Monad (return, (>>)), Functor(..), liftM, join)
import Data.Char (ord)
import Data.Maybe (fromMaybe)
import XMonad
import XMonad.Util.Run (safeSpawn, unsafeSpawn)
import Codec.Binary.UTF8.String (decode)
{- $usage
Add @import XMonad.Util.XSelection@ to the top of Config.hs
Then make use of getSelection or promptSelection as needed; if
one wanted to run Firefox with the selection as an argument (perhaps
the selection string is an URL you just highlighted), then one could add
to the xmonad.hs a line like thus:
> , ((modMask .|. shiftMask, xK_b), promptSelection "firefox")
There are a number of known problems with XSelection:
* Unicode handling is busted. But it's still better than calling
'chr' to translate to ASCII, at least.
As near as I can tell, the mangling happens when the String is
outputted somewhere, such as via promptSelection's passing through
the shell, or GHCi printing to the terminal. utf-string has IO functions
which can fix this, though I do not know have to use them here. It's
a complex issue; see
<http://www.haskell.org/pipermail/xmonad/2007-September/001967.html>
and <http://www.haskell.org/pipermail/xmonad/2007-September/001966.html>.
* Needs more elaborate functionality: Emacs' registers are nice; if you
don't know what they are, see <http://www.gnu.org/software/emacs/manual/html_node/emacs/Registers.html#Registers> -}
-- | Returns a String corresponding to the current mouse selection in X; if there is none, an empty string is returned. Note that this is
-- really only reliable for ASCII text and currently escapes or otherwise mangles more complex UTF-8 characters.
getSelection :: MonadIO m => m String
getSelection = io $ do
dpy <- openDisplay ""
let dflt = defaultScreen dpy
rootw <- rootWindow dpy dflt
win <- createSimpleWindow dpy rootw 0 0 1 1 0 0 0
p <- internAtom dpy "PRIMARY" True
ty <- E.catch
(E.catch
(internAtom dpy "UTF8_STRING" False)
(\_ -> internAtom dpy "COMPOUND_TEXT" False))
(\_ -> internAtom dpy "sTring" False)
clp <- internAtom dpy "BLITZ_SEL_STRING" False
xConvertSelection dpy p ty clp win currentTime
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 ""
-- | Set the current X Selection to a specified string.
putSelection :: MonadIO m => String -> m ()
putSelection text = io $ do
dpy <- openDisplay ""
let dflt = defaultScreen dpy
rootw <- rootWindow dpy dflt
win <- createSimpleWindow dpy rootw 0 0 1 1 0 0 0
p <- internAtom dpy "PRIMARY" True
ty <- internAtom dpy "UTF8_STRING" False
xSetSelectionOwner dpy p win currentTime
winOwn <- xGetSelectionOwner dpy p
if winOwn == win
then do forkIO ((allocaXEvent $ processEvent dpy ty text) >> destroyWindow dpy win) >> return ()
else do putStrLn "Unable to obtain ownership of the selection" >> destroyWindow dpy win
return ()
where
processEvent :: Display -> Atom -> [Char] -> XEventPtr -> IO ()
processEvent dpy ty txt e = do
nextEvent dpy e
ev <- getEvent e
if ev_event_type ev == selectionRequest
then do print ev
allocaXEvent $ \replyPtr -> do
changeProperty8 (ev_event_display ev)
(ev_requestor ev)
(ev_property ev)
ty
propModeReplace
(map (fromIntegral . ord) txt)
setSelectionNotify replyPtr (ev_requestor ev) (ev_selection ev)
(ev_target ev) (ev_property ev) (ev_time ev)
sendEvent dpy (ev_requestor ev) False noEventMask replyPtr
sync dpy False
else do putStrLn "Unexpected Message Received"
print ev
processEvent dpy ty text e
{- | 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
@promptSelection \"firefox\"@;
this would allow you to highlight a URL string and then immediately open it up in Firefox.
'promptSelection' passes strings through the system shell, \/bin\/sh; if you do not wish your selected text
to be interpreted or mangled by the shell, use 'safePromptSelection'. safePromptSelection will bypass the
shell using 'safeSpawn' from "XMonad.Util.Run"; see its documentation for more
details on the advantages and disadvantages of using safeSpawn. -}
promptSelection, safePromptSelection, unsafePromptSelection :: String -> X ()
promptSelection = unsafePromptSelection
safePromptSelection app = join $ io $ liftM (safeSpawn app . return) getSelection
unsafePromptSelection app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) getSelection
{- | A wrapper around 'promptSelection' and its safe variant. They take two parameters, the first is a function that transforms strings, and the second is the application to run. The transformer essentially transforms the selection in X.
One example is to wrap code, such as a command line action copied out of the browser to be run as @"sudo" ++ cmd@ or @"su - -c \""++ cmd ++"\""@.
-}
transformPromptSelection, transformSafePromptSelection :: (String -> String) -> String -> X ()
transformPromptSelection f app = join $ io $ liftM (safeSpawn app . return) (fmap f getSelection)
transformSafePromptSelection f app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) (fmap f getSelection)
|
