mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-08-01 12:41:52 -07:00
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.
This commit is contained in:
gwern0
154
XSelection.hs
Normal file
154
XSelection.hs
Normal file
@@ -0,0 +1,154 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonadContrib.XSelection
|
||||
-- Copyright : (C) 2007 Andrea Rossato, Matthew Sackman
|
||||
-- License : BSD3
|
||||
--
|
||||
-- Maintainer : Andrea Rossato <andrea.rossato@unibz.it>, Matthew Sackman <matthew@wellquite.org>
|
||||
-- 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
|
||||
<http://www.haskell.org/pipermail/xmonad/2007-September/001967.html>
|
||||
and <http://www.haskell.org/pipermail/xmonad/2007-September/001966.html>.
|
||||
* 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
|
||||
<http://code.haskell.org/utf8-string/> (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
|
||||
Reference in New Issue
Block a user