mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-08-03 21:51:52 -07:00
update XSelection.hs; apparently the utf8-string library has updated
Note that this does not fix the apparent problems with actually using getSelection, even though it works fine from a GHCi prompt...
This commit is contained in:
@@ -23,6 +23,13 @@ module XMonad.Util.XSelection (
|
|||||||
safePromptSelection,
|
safePromptSelection,
|
||||||
putSelection) where
|
putSelection) where
|
||||||
|
|
||||||
|
import Control.Concurrent (forkIO)
|
||||||
|
import Control.Exception as E (catch)
|
||||||
|
import Control.Monad(Monad (return, (>>)), Functor(..), liftM, join)
|
||||||
|
import Data.Bits (shiftL, (.&.), (.|.))
|
||||||
|
import Data.Char (chr, ord)
|
||||||
|
import Data.Maybe (fromMaybe)
|
||||||
|
import Data.Word (Word8)
|
||||||
import Graphics.X11.Xlib.Extras (Event(ev_event_display,
|
import Graphics.X11.Xlib.Extras (Event(ev_event_display,
|
||||||
ev_time, ev_property, ev_target, ev_selection,
|
ev_time, ev_property, ev_target, ev_selection,
|
||||||
ev_requestor, ev_event_type),
|
ev_requestor, ev_event_type),
|
||||||
@@ -32,15 +39,8 @@ import Graphics.X11.Xlib.Extras (Event(ev_event_display,
|
|||||||
import Graphics.X11.Xlib (destroyWindow, createSimpleWindow, Display, XEventPtr,
|
import Graphics.X11.Xlib (destroyWindow, createSimpleWindow, Display, XEventPtr,
|
||||||
sendEvent, nextEvent, sync, allocaXEvent, openDisplay, rootWindow,
|
sendEvent, nextEvent, sync, allocaXEvent, openDisplay, rootWindow,
|
||||||
defaultScreen, internAtom, Atom, selectionNotify, selectionRequest, noEventMask)
|
defaultScreen, internAtom, Atom, selectionNotify, selectionRequest, noEventMask)
|
||||||
import Control.Concurrent (forkIO)
|
|
||||||
import Control.Exception as E (catch)
|
|
||||||
import Control.Monad(Monad (return, (>>)), Functor(..), liftM, join)
|
|
||||||
import Data.Char (chr, ord)
|
|
||||||
import Data.Maybe (fromMaybe)
|
|
||||||
import Foreign.C.Types (CChar)
|
|
||||||
import Data.Bits (shiftL, (.&.), (.|.))
|
|
||||||
import XMonad.Util.Run (safeSpawn, unsafeSpawn)
|
|
||||||
import XMonad (X, io)
|
import XMonad (X, io)
|
||||||
|
import XMonad.Util.Run (safeSpawn, unsafeSpawn)
|
||||||
|
|
||||||
{- $usage
|
{- $usage
|
||||||
Add 'import XMonad.Util.XSelection' to the top of Config.hs
|
Add 'import XMonad.Util.XSelection' to the top of Config.hs
|
||||||
@@ -52,7 +52,6 @@ import XMonad (X, io)
|
|||||||
> , ((modMask .|. shiftMask, xK_b ), promptSelection "firefox")
|
> , ((modMask .|. shiftMask, xK_b ), promptSelection "firefox")
|
||||||
|
|
||||||
TODO:
|
TODO:
|
||||||
|
|
||||||
* Fix Unicode handling. Currently it's still better than calling
|
* Fix Unicode handling. Currently it's still better than calling
|
||||||
'chr' to translate to ASCII, though.
|
'chr' to translate to ASCII, though.
|
||||||
As near as I can tell, the mangling happens when the String is
|
As near as I can tell, the mangling happens when the String is
|
||||||
@@ -63,8 +62,7 @@ import XMonad (X, io)
|
|||||||
<http://www.haskell.org/pipermail/xmonad/2007-September/001967.html>
|
<http://www.haskell.org/pipermail/xmonad/2007-September/001967.html>
|
||||||
and <http://www.haskell.org/pipermail/xmonad/2007-September/001966.html>.
|
and <http://www.haskell.org/pipermail/xmonad/2007-September/001966.html>.
|
||||||
|
|
||||||
* Possibly add some more elaborate functionality: Emacs' registers are nice.
|
* Possibly add some more elaborate functionality: Emacs' registers are nice. -}
|
||||||
-}
|
|
||||||
|
|
||||||
-- | Returns a String corresponding to the current mouse selection in X; if there is none, an empty string is returned. Note that this is
|
-- | 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.
|
-- really only reliable for ASCII text and currently escapes or otherwise mangles more complex UTF-8 characters.
|
||||||
@@ -87,7 +85,7 @@ getSelection = do
|
|||||||
ev <- getEvent e
|
ev <- getEvent e
|
||||||
if ev_event_type ev == selectionNotify
|
if ev_event_type ev == selectionNotify
|
||||||
then do res <- getWindowProperty8 dpy clp win
|
then do res <- getWindowProperty8 dpy clp win
|
||||||
return $ decode . fromMaybe [] $ res
|
return $ decode . map fromIntegral . fromMaybe [] $ res
|
||||||
else destroyWindow dpy win >> return ""
|
else destroyWindow dpy win >> return ""
|
||||||
|
|
||||||
-- | Set the current X Selection to a given String.
|
-- | Set the current X Selection to a given String.
|
||||||
@@ -112,9 +110,6 @@ putSelection text = do
|
|||||||
ev <- getEvent e
|
ev <- getEvent e
|
||||||
if ev_event_type ev == selectionRequest
|
if ev_event_type ev == selectionRequest
|
||||||
then do print ev
|
then do print ev
|
||||||
-- selection == eg PRIMARY
|
|
||||||
-- target == type eg UTF8
|
|
||||||
-- property == property name or None
|
|
||||||
allocaXEvent $ \replyPtr -> do
|
allocaXEvent $ \replyPtr -> do
|
||||||
changeProperty8 (ev_event_display ev)
|
changeProperty8 (ev_event_display ev)
|
||||||
(ev_requestor ev)
|
(ev_requestor ev)
|
||||||
@@ -122,7 +117,8 @@ putSelection text = do
|
|||||||
ty
|
ty
|
||||||
propModeReplace
|
propModeReplace
|
||||||
(map (fromIntegral . ord) txt)
|
(map (fromIntegral . ord) txt)
|
||||||
setSelectionNotify replyPtr (ev_requestor ev) (ev_selection ev) (ev_target ev) (ev_property ev) (ev_time ev)
|
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
|
sendEvent dpy (ev_requestor ev) False noEventMask replyPtr
|
||||||
sync dpy False
|
sync dpy False
|
||||||
else do putStrLn "Unexpected Message Received"
|
else do putStrLn "Unexpected Message Received"
|
||||||
@@ -142,11 +138,13 @@ promptSelection = unsafePromptSelection
|
|||||||
safePromptSelection app = join $ io $ liftM (safeSpawn app) (getSelection)
|
safePromptSelection app = join $ io $ liftM (safeSpawn app) (getSelection)
|
||||||
unsafePromptSelection app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) getSelection
|
unsafePromptSelection app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) getSelection
|
||||||
|
|
||||||
{- UTF-8 decoding for internal use in getSelection. This code is copied from Eric Mertens's utf-string library
|
{- | Decode a UTF8 string packed into a list of Word8 values, directly to
|
||||||
|
String; does not deal with CChar, hence you will want the counter-intuitive 'map fromIntegral'.
|
||||||
|
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.
|
<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
|
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. -}
|
dependencies already. -}
|
||||||
decode :: [CChar] -> String
|
decode :: [Word8] -> String
|
||||||
decode [ ] = ""
|
decode [ ] = ""
|
||||||
decode (c:cs)
|
decode (c:cs)
|
||||||
| c < 0x80 = chr (fromEnum c) : decode cs
|
| c < 0x80 = chr (fromEnum c) : decode cs
|
||||||
@@ -158,19 +156,21 @@ decode (c:cs)
|
|||||||
| c < 0xfe = multi_byte 5 0x1 0x4000000
|
| c < 0xfe = multi_byte 5 0x1 0x4000000
|
||||||
| otherwise = replacement_character : decode cs
|
| otherwise = replacement_character : decode cs
|
||||||
where
|
where
|
||||||
|
|
||||||
replacement_character :: Char
|
replacement_character :: Char
|
||||||
replacement_character = '\xfffd'
|
replacement_character = '\xfffd'
|
||||||
|
|
||||||
multi_byte :: Int -> CChar -> Int -> [Char]
|
multi_byte :: Int -> Word8 -> Int -> [Char]
|
||||||
multi_byte i mask overlong = aux i cs (fromEnum (c .&. mask))
|
multi_byte i mask overlong = aux i cs (fromEnum (c .&. mask))
|
||||||
where
|
where
|
||||||
aux :: Int -> [CChar] -> Int -> [Char]
|
|
||||||
aux 0 rs acc
|
aux 0 rs acc
|
||||||
| overlong <= acc && acc <= 0x10ffff &&
|
| overlong <= acc && acc <= 0x10ffff &&
|
||||||
(acc < 0xd800 || 0xdfff < acc) &&
|
(acc < 0xd800 || 0xdfff < acc) &&
|
||||||
(acc < 0xfffe || 0xffff < acc) = chr acc : decode rs
|
(acc < 0xfffe || 0xffff < acc) = chr acc : decode rs
|
||||||
| otherwise = replacement_character : decode rs
|
| otherwise = replacement_character : decode rs
|
||||||
|
|
||||||
aux n (r:rs) acc
|
aux n (r:rs) acc
|
||||||
| r .&. 0xc0 == 0x80 = aux (n-1) rs
|
| r .&. 0xc0 == 0x80 = aux (n-1) rs
|
||||||
$ shiftL acc 6 .|. fromEnum (r .&. 0x3f)
|
$ shiftL acc 6 .|. fromEnum (r .&. 0x3f)
|
||||||
|
|
||||||
aux _ rs _ = replacement_character : decode rs
|
aux _ rs _ = replacement_character : decode rs
|
||||||
|
Reference in New Issue
Block a user