[Xmonad] darcs patch: Extras.hsc: added xSetSelectionOwner,
xGetSelectionOwn...
Donald Bruce Stewart
dons at cse.unsw.edu.au
Mon Aug 6 22:05:03 EDT 2007
mailing_list:
> On Mon, Aug 06, 2007 at 11:38:34AM +0200, Andrea Rossato wrote:
> > Hi,
> >
> > with this patch the we can write applications with cut and paste
> > capabilities.
>
> just to test it, this does the job of sselp
> (http://www.suckless.org/download/sselp-0.1.tar.gz).
>
> cool, isn't it?
> ciao
> andrea
>
> the code:
>
> module Main where
> import Graphics.X11.Xlib
> import Graphics.X11.Xlib.Extras
> import System.Exit (exitWith, ExitCode(..))
>
> import Data.Maybe
> import Data.Char
>
> main :: IO ()
> main = do
> dpy <- openDisplay ""
> let dflt = defaultScreen dpy
> scr = defaultScreenOfDisplay dpy
> rootw <- rootWindow dpy dflt
> win <- createSimpleWindow dpy rootw 0 0 200 100 0 0 0
> p <- internAtom dpy "PRIMARY" True
> clp <- internAtom dpy "BLITZ_SEL_STRING" False
> xConvertSelection dpy p sTRING 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
> putStrLn $ map (chr . fromIntegral) . fromMaybe [] $ res
> else do putStrLn "failed!"
> destroyWindow dpy win
> exitWith ExitSuccess
Cute stuff!
I wonder if we can't get a nicer, more haskellish, EDSL for doing these
kinds of things. Its still too C-ish for wide use by the community.
More information about the Xmonad
mailing list