From e5704f7e53d377d55237282e076f415e6ad29f30 Mon Sep 17 00:00:00 2001 From: gwern0 Date: Tue, 9 Oct 2007 00:27:06 +0200 Subject: XSelection.hs: a new module for XMonadContrib dealing with copy-and-paste This is based on Andrea Rossato's standalone tools and is meant for integration straight into a Config.hs. It offers two main functions, 'getSelection' and 'putSelection', whose names should be self-explanatory. darcs-hash:20071008222706-f7719-a064aa284a8434d993bc6c002b11eb85d037461d.gz --- XSelection.hs | 154 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 154 insertions(+) create mode 100644 XSelection.hs (limited to 'XSelection.hs') diff --git a/XSelection.hs b/XSelection.hs new file mode 100644 index 0000000..dfd235c --- /dev/null +++ b/XSelection.hs @@ -0,0 +1,154 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonadContrib.XSelection +-- Copyright : (C) 2007 Andrea Rossato, Matthew Sackman +-- License : BSD3 +-- +-- Maintainer : Andrea Rossato , Matthew Sackman +-- Stability : unstable +-- Portability : unportable +-- +-- A module for accessing and manipulating the X Window mouse selection (used in copy and pasting). +-- getSelection and putSelection are adaptations of Hxsel.hs and Hxput.hs from XMonad-utils, available: +-- $ darcs get http://gorgias.mine.nu/repos/xmonad-utils +----------------------------------------------------------------------------- +{- $usage + Add 'import XMonadContrib.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 (say, + the selection is an URL you just highlighted), then one could add + to the Config.hs a line like thus: + , ((modMask .|. shiftMask, xK_b ), promptSelection "firefox") + + TODO: + * Fix Unicode handling. Currently it's still better than calling + 'chr' to translate to ASCII, though. + 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 + + and . + * Possibly add some more elaborate functionality: Emacs' registers are nice. +-} + +module XMonadContrib.XSelection (getSelection, promptSelection, putSelection) where + +-- getSelection, putSelection's imports: +import Graphics.X11.Xlib (allocaXEvent, createSimpleWindow, defaultScreen, destroyWindow, internAtom, nextEvent, openDisplay, rootWindow, selectionNotify, Display(), Atom(), XEventPtr(), selectionRequest, sendEvent, noEventMask, sync) +import Graphics.X11.Xlib.Extras (currentTime, ev_event_type, getEvent, getWindowProperty8, xConvertSelection, xSetSelectionOwner, xGetSelectionOwner, changeProperty8, propModeReplace, setSelectionNotify, ev_requestor, ev_selection, ev_target, ev_property, ev_time, ev_event_display) +import Data.Maybe (fromMaybe) +import Control.Concurrent (forkIO) +import Data.Char (chr, ord) + +-- promptSelection's imports: +import XMonad (io, spawn, X ()) + +-- decode's imports +import Foreign (Word8(), (.&.), shiftL, (.|.)) + +-- | Returns a String corresponding to the current mouse selection in X; if there is none, an empty string is returned.. Note that this is +-- only reliable for ASCII text and currently mangles/escapes more complex UTF-8 characters. +getSelection :: IO String +getSelection = do + dpy <- openDisplay "" + let dflt = defaultScreen dpy + rootw <- rootWindow dpy dflt + win <- createSimpleWindow dpy rootw 0 0 200 100 0 0 0 + p <- internAtom dpy "PRIMARY" True + ty <- internAtom dpy "UTF8_STRING" False +-- import Control.Exception as E (catch) +{- ty <- E.catch + (E.catch + (internAtom dpy "sTring" False) + (\_ -> internAtom dpy "COMPOUND_TEXT" False)) + (\_ -> internAtom dpy "UTF8_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 . fromMaybe [] $ res + else destroyWindow dpy win >> return "" + +-- | Set the current X Selection to a given String. +putSelection :: String -> IO () +putSelection text = do + dpy <- openDisplay "" + let dflt = defaultScreen dpy + rootw <- rootWindow dpy dflt + win <- createSimpleWindow dpy rootw 0 0 200 100 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 + -- selection == eg PRIMARY + -- target == type eg UTF8 + -- property == property name or None + 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 :: String -> X () +promptSelection app = spawn . ((app ++ " ") ++) =<< io getSelection + +{- UTF-8 decoding for internal use in getSelection. This code is copied from Eric Mertens's utf-string library + (version 0.1), which is BSD-3 licensed, as is this module. + It'd be better to just import Codec.Binary.UTF8.String (decode), but then users of this would need to install it; Xmonad has enough + dependencies already. -} +decode :: [Word8] -> String +decode [ ] = "" +decode (c:cs) + | c < 0x80 = chr (fromEnum c) : decode cs + | c < 0xc0 = replacement_character : decode cs + | c < 0xe0 = multi_byte 1 0x1f 0x80 + | c < 0xf0 = multi_byte 2 0xf 0x800 + | c < 0xf8 = multi_byte 3 0x7 0x10000 + | c < 0xfc = multi_byte 4 0x3 0x200000 + | c < 0xfe = multi_byte 5 0x1 0x4000000 + | otherwise = replacement_character : decode cs + where + replacement_character :: Char + replacement_character = '\xfffd' + + multi_byte :: Int -> Word8 -> Int -> [Char] + multi_byte i mask overlong = aux i cs (fromEnum (c .&. mask)) + where + aux 0 rs acc + | overlong <= acc && acc <= 0x10ffff && + (acc < 0xd800 || 0xdfff < acc) && + (acc < 0xfffe || 0xffff < acc) = chr acc : decode rs + | otherwise = replacement_character : decode rs + + aux n (r:rs) acc + | r .&. 0xc0 == 0x80 = aux (n-1) rs + $ shiftL acc 6 .|. fromEnum (r .&. 0x3f) + + aux _ rs _ = replacement_character : decode rs -- cgit v1.2.3