Allow to get and paste digraph

A prompt shows up for Super+d requesting 2 characters for a digraph. They
are then passed to vim which generates the digraph which is then pasted
to current window.

Signed-off-by: Michal Minář <mic.liamg@gmail.com>

6 files changed, 156 insertions, 41 deletions

diff --git a/src/XMonad/Local/Actions.hs b/src/XMonad/Local/Actions.hs
index f5e0cc1..aca23af 100644
--- a/src/XMonad/Local/Actions.hs
+++ b/src/XMonad/Local/Actions.hs
@@ -3,14 +3,11 @@
 
 module XMonad.Local.Actions where
 
-import           Codec.Binary.UTF8.String
 import           Control.Monad
 import           Data.Maybe
-import           System.IO
 import           System.Posix.Directory
 import           System.Posix.Env
 import           System.Posix.Signals         (Signal, signalProcess)
-import           System.Process               (runInteractiveProcess)
 
 import           XMonad
 import qualified XMonad.Actions.TopicSpace    as TS
@@ -19,6 +16,8 @@ import qualified XMonad.Util.WindowProperties as WP
 
 -- local modules **************************************************************
 import qualified XMonad.Local.Config          as Local
+import qualified XMonad.Local.Prompt          as Local
+import qualified XMonad.Local.Util            as Local
 
 -- launch applications ********************************************************
 spawnExplorer ∷ X ()
@@ -70,38 +69,32 @@ mateRun = withDisplay $ \dpy -> do
 clipboardManager ∷ String
 clipboardManager = "/usr/bin/clipit"
 
-runProcessAndLogError ∷ MonadIO m ⇒ FilePath → [String] → String → m (Maybe String)
-runProcessAndLogError cmd args input = io $ do
-    (pin, pout, perr, _) <- runInteractiveProcess (encodeString cmd) (map encodeString args) Nothing Nothing
-    hPutStr pin input
-    hClose pin
-    output <- hGetContents pout
-    when (output == output) $ return ()
-    err <- hGetContents perr
-    when (err == err) $ return ()
-    hClose pout
-    hClose perr
-    unless (null err) $ hPrint stderr $ "failed to run " ++ clipboardManager ++ ": " ++ err
-    -- no need to waitForProcess, we ignore SIGCHLD
-    return $ Just output
-
 getClipboardText ∷ X (Maybe String)
 getClipboardText = catchX
-    (runProcessAndLogError clipboardManager ["-c"] "")
+    (Local.runProcessAndLogError clipboardManager ["-c"] "")
     (io $ return Nothing)
 
 saveTextToClipboard ∷ String → X ()
 saveTextToClipboard text = catchX
-    (void (runProcessAndLogError clipboardManager [] text))
+    (void (Local.runProcessAndLogError clipboardManager [] text))
     (io $ return ())
 
+getAndPasteDigraph ∷ X ()
+getAndPasteDigraph = do
+    dg <- Local.digraphPrompt
+    case dg of
+        Just text@(_:_) -> do
+            saveTextToClipboard text
+            Paste.pasteChar controlMask 'V'
+        _               -> io $ return ()
+
 -- | Turn the current entry in clipboard into plain text and paste it to the
 -- current window using Ctrl+v shortcut.
 pastePlainTextFromClipboard ∷ X ()
 pastePlainTextFromClipboard = do
     t <- getClipboardText
     case t of
-        Just text -> do
+        Just text@(_:_) -> do
             saveTextToClipboard text
             Paste.pasteChar controlMask 'V'
-        Nothing   -> io $ return ()
+        _               -> io $ return ()
diff --git a/src/XMonad/Local/Config.hs b/src/XMonad/Local/Config.hs
index 1eefce8..fc6f0ac 100644
--- a/src/XMonad/Local/Config.hs
+++ b/src/XMonad/Local/Config.hs
@@ -1,23 +1,17 @@
-module XMonad.Local.Config (
-      browser
-    , explorer
-    , xpConfig
-    , terminal
-    , tabsOutlinerAppID
-    , tabsOutlinerAppName
-    , tabsOutlinerFloatRect
-    ) where
-
-import qualified XMonad.Prompt as P
+{-# LANGUAGE UnicodeSyntax #-}
+
+module XMonad.Local.Config where
+
+import qualified XMonad.Prompt   as P
 import qualified XMonad.StackSet as W
 
-explorer :: String
+explorer ∷ String
 explorer = "caja"
 
-terminal :: String
+terminal ∷ String
 terminal = "st"
 
-xpConfig :: P.XPConfig
+xpConfig ∷ P.XPConfig
 xpConfig = P.def
     { P.fgColor = "#dfdfdf"
     , P.bgColor = "#3c3c3c"
@@ -27,12 +21,15 @@ xpConfig = P.def
     , P.height  = 24
     }
 
-browser :: String
+browser ∷ String
 browser = "google-chrome-stable"
 
-tabsOutlinerAppID :: String
+vimBundlePath ∷ String
+vimBundlePath = "~/.vim/bundle/vundle"
+
+tabsOutlinerAppID ∷ String
 tabsOutlinerAppID = "eggkanocgddhmamlbiijnphhppkpkmkl"
-tabsOutlinerAppName :: String
-tabsOutlinerAppName = "crx_" ++ tabsOutlinerAppID 
-tabsOutlinerFloatRect :: W.RationalRect
+tabsOutlinerAppName ∷ String
+tabsOutlinerAppName = "crx_" ++ tabsOutlinerAppID
+tabsOutlinerFloatRect ∷ W.RationalRect
 tabsOutlinerFloatRect = W.RationalRect (1/5) (1/11) (3/5) (7/9)
diff --git a/src/XMonad/Local/Keys.hs b/src/XMonad/Local/Keys.hs
index 39ab8c1..4453a8c 100644
--- a/src/XMonad/Local/Keys.hs
+++ b/src/XMonad/Local/Keys.hs
@@ -203,6 +203,7 @@ genericKeys conf = [
     -- misc
     , ("S-h", PSsh.sshPrompt xpConfig)
     , ("v", Local.pastePlainTextFromClipboard)
+    , ("d", Local.getAndPasteDigraph)
     --, ("<Print>", spawn "xfce4-screenshooter")
     , ("y", SUB.submap $ EZ.mkKeymap conf $ concat
         [ [(k, a), (modm ++ "-" ++ k, a)]
diff --git a/src/XMonad/Local/Prompt.hs b/src/XMonad/Local/Prompt.hs
new file mode 100644
index 0000000..5734fc8
--- /dev/null
+++ b/src/XMonad/Local/Prompt.hs
@@ -0,0 +1,86 @@
+{-# LANGUAGE DoAndIfThenElse #-}
+{-# LANGUAGE UnicodeSyntax   #-}
+
+module XMonad.Local.Prompt (
+    digraphPrompt,
+    getDigraphForString
+) where
+
+import           Control.Exception
+import           Control.Monad
+import           System.Directory
+import           System.IO
+import qualified System.IO.Temp      as Temp
+
+import           XMonad
+import           XMonad.Prompt
+
+-- local modules **************************************************************
+import qualified XMonad.Local.Config as Local
+import qualified XMonad.Local.Util   as Local
+
+-- digraph prompt *************************************************************
+data Digraph = Digraph
+
+instance XPrompt Digraph where
+    showXPrompt Digraph = "Two ASCII characters: "
+
+-- | According to RFC 1345
+digraphChars ∷ String
+digraphChars = "!\"%'()*+,-./0123456789:;<=>?"
+            ++ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
+
+digraphCompletionFunction ∷ String → IO [String]
+digraphCompletionFunction = return . gen
+    where
+        gen ∷ String → [String]
+        gen []                                      = [x:"?" | x <- digraphChars]
+        gen [x]    |    x `elem` digraphChars       = [[x, y] | y <- '_':digraphChars]
+                   |    otherwise                   = []
+        gen [x, y] |    x `elem` digraphChars
+                     && y `elem` ('_':digraphChars) = [[x, y]]
+                   |    otherwise                   = []
+        gen _                                       = []
+
+vimEchoDigraphConfig ∷ String
+vimEchoDigraphConfig = unlines [
+    "set noswapfile",
+    "set nocompatible",
+    "filetype off",
+    "\" load unicode plugin for unicode#Digraph function",
+    "set rtp+=" ++ Local.vimBundlePath,
+    "call vundle#begin()",
+    "Plugin 'chrisbra/unicode.vim'",
+    "call vundle#end()"]
+
+vimBinary ∷ String
+vimBinary = "/usr/bin/vim"
+
+-- |
+-- TODO: make it vim independent
+getDigraphForString ∷ String → X String
+getDigraphForString str = io $
+    Temp.withSystemTempFile "xminad-digraph-config.vimrc" $ \filePath h ->
+        finally (runVim filePath h) (removeFile filePath)
+    where
+        cmdMkDigraph = "+call setline(1, unicode#Digraph(getline(1)[0:1]))"
+        cmdWriteAndQuit = "+w!/dev/stderr|q!"
+
+        runVim ∷ FilePath → Handle → IO String
+        runVim filePath h = do
+            finally (hPutStr h vimEchoDigraphConfig) (hClose h)
+            (_, dg) <- Local.runProcessAndGetOutputs vimBinary
+                ["-", "-esbu", filePath, cmdMkDigraph, cmdWriteAndQuit]
+                str
+            when (null dg) (hPrint stderr $ "failed to get digraph for input '" ++ str ++ "'\n")
+            return dg
+
+-- | Prompts for two characters and passes them to vim to get corresponding
+-- digraph.
+-- NOTE: Even if return value is Just, the string may still be empty if the
+-- vim couldn't make digraph out of the input.
+digraphPrompt ∷ X (Maybe String)
+digraphPrompt = catchX
+     (mkXPromptWithReturn Digraph
+        Local.xpConfig digraphCompletionFunction getDigraphForString)
+     (io $ return Nothing)
diff --git a/src/XMonad/Local/Util.hs b/src/XMonad/Local/Util.hs
new file mode 100644
index 0000000..0b754ce
--- /dev/null
+++ b/src/XMonad/Local/Util.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE DoAndIfThenElse #-}
+{-# LANGUAGE UnicodeSyntax   #-}
+
+module XMonad.Local.Util where
+
+import Codec.Binary.UTF8.String
+import Control.Monad
+import System.IO
+import System.Process           (runInteractiveProcess)
+
+import XMonad
+
+-- utilities ******************************************************************
+runProcessAndGetOutputs ∷ MonadIO m ⇒ FilePath → [String] → String → m (String, String)
+runProcessAndGetOutputs cmd args input = io $ do
+    (pin, pout, perr, _) <- runInteractiveProcess (encodeString cmd) (map encodeString args) Nothing Nothing
+    hPutStr pin input
+    hClose pin
+    output <- hGetContents pout
+    when (output == output) $ return ()
+    err <- hGetContents perr
+    when (err == err) $ return ()
+    hClose pout
+    hClose perr
+    -- no need to waitForProcess, we ignore SIGCHLD
+    return (output, err)
+
+runProcessAndLogError ∷ MonadIO m ⇒ FilePath → [String] → String → m (Maybe String)
+runProcessAndLogError cmd args input = do
+    (out, err) <- runProcessAndGetOutputs cmd args input
+    if null err then
+        return (Just out)
+    else do
+        io $ hPrint stderr $ "failed to run " ++ cmd ++ ": " ++ err
+        return Nothing
diff --git a/xminad.cabal b/xminad.cabal
index 4abc18e..2d85c23 100644
--- a/xminad.cabal
+++ b/xminad.cabal
@@ -60,7 +60,9 @@ Library
     XMonad.Local.Mouse
     XMonad.Local.Music
     XMonad.Local.NamedScratchpad
+    XMonad.Local.Prompt
     XMonad.Local.TopicSpace
+    XMonad.Local.Util
     XMonad.Local.Workspaces
     XMonad.Local.XConfig
 
@@ -79,6 +81,7 @@ Library
     , process        >=1.2  && <1.6
     , regex-compat   >=0.90 && <1.0
     , regex-posix    >=0.90 && <1.0
+    , temporary      >=1.1  && <1.4
     , unix           >=2.0  && <3.0
     , utf8-string    >=0.3  && <1.1
     , xmonad         >=0.12 && <0.13