diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,24 @@ +Copyright (c) 2014, osdkeys +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of osdkeys nor the + names of its contributors may be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL BE LIABLE FOR ANY +DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/osdkeys.cabal b/osdkeys.cabal new file mode 100644 --- /dev/null +++ b/osdkeys.cabal @@ -0,0 +1,38 @@ +name: osdkeys +version: 0.0 +synopsis: Show keys pressed with an on-screen display (Linux only) +description: This program uses the xinput program to get a stream of key presses + and uses the libnotify library to display them on-screen. + . + Currently supported display notations are: Emacs +license: BSD3 +license-file: LICENSE +author: Chris Done +maintainer: chrisdone@gmail.com +copyright: 2014 Chris Done +category: Screencast +build-type: Simple +cabal-version: >=1.8 + +library + hs-source-dirs: src/ + ghc-options: -Wall -O2 + exposed-modules: OSDKeys, OSDKeys.Types, OSDKeys.XInput + other-modules: OSDKeys.Mappings + build-depends: base >= 4 && <5 + , bytestring + , conduit + , conduit-extra + , containers + , libnotify + , resourcet + , time + , transformers + +executable osdkeys + hs-source-dirs: src/main/ + ghc-options: -Wall -O2 -threaded + main-is: Main.hs + build-depends: base >= 4 && < 5 + , osdkeys + , process diff --git a/src/OSDKeys.hs b/src/OSDKeys.hs new file mode 100644 --- /dev/null +++ b/src/OSDKeys.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE BangPatterns #-} + +-- | Show keys pressed with an on-screen display (Linux only). + +module OSDKeys (startOSDKeys) where + +import OSDKeys.Mappings +import OSDKeys.Types +import OSDKeys.XInput + +import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.Trans.Resource +import Data.Conduit +import qualified Data.Conduit.List as CL +import Data.Foldable (toList) +import Data.Maybe +import Data.Sequence ((|>)) +import qualified Data.Sequence as Q +import qualified Data.Set as S +import Libnotify + +-- | Main entry point. +startOSDKeys :: Device -> Int -> IO () +startOSDKeys d maxCombos = + do token <- display (summary "Keys pressed" <> + body "Started!") + void (runResourceT + (void (xinputSource d) $$ + CL.foldM (consume token) + (State mempty mempty))) + where consume token state event = + liftIO (do let !newState = + update state maxCombos event + display_ (reuse token <> + body (encodeNotify (showEmacsCombos (toList (stateCombos newState))))) + return newState) + +-- | Update the state with the new key event. +update :: State -> Int -> (Event,KeyCode) -> State +update state@(State modifiers combos) maxCombos (event,code) = + if elem key modifierKeys + then state {stateModifiers = + case event of + Press -> + S.insert key modifiers + Release -> + S.delete key modifiers} + else case event of + Press -> + state {stateCombos = + limit (combos |> + Combo modifiers key)} + Release -> state + where key = + fromMaybe (Unknown code) + (lookup code codeMapping) + limit s = + if Q.length s > maxCombos + then Q.drop 1 s + else s + +-- | Encode some string for notify. +encodeNotify :: String -> String +encodeNotify = go + where go (x:xs) + | Just rep <- lookup x encodingMap = rep ++ go xs + | otherwise = x : go xs + go [] = [] + +-- | Pseudo-HTML mapping for for notify. +encodingMap :: [(Char,String)] +encodingMap = + [('&',"&") + ,('<',"<") + ,('>',">") + ,('\'',"'") + ,('"',""")] diff --git a/src/OSDKeys/Mappings.hs b/src/OSDKeys/Mappings.hs new file mode 100644 --- /dev/null +++ b/src/OSDKeys/Mappings.hs @@ -0,0 +1,232 @@ +-- | Various key mappings. + +module OSDKeys.Mappings where + +import OSDKeys.Types + +import Data.Foldable (toList) +import Data.Monoid +import qualified Data.Set as S + +-- | Mapping from keycodes to something for humans to read. +codeMapping :: [(KeyCode, Key)] +codeMapping = + [(50,ShiftL) + ,(62,ShiftR) + ,(37,CtrlL) + ,(105,CtrlR) + ,(64,AltL) + ,(108,AltR) + ,(133,SuperL) + ,(134,SuperR) + ,(24,Plain 'q') + ,(25,Plain 'w') + ,(26,Plain 'e') + ,(27,Plain 'r') + ,(28,Plain 't') + ,(29,Plain 'y') + ,(30,Plain 'u') + ,(31,Plain 'i') + ,(32,Plain 'o') + ,(33,Plain 'p') + ,(34,Plain '[') + ,(35,Plain ']') + ,(51,Plain '\\') + ,(38,Plain 'a') + ,(39,Plain 's') + ,(40,Plain 'd') + ,(41,Plain 'f') + ,(42,Plain 'g') + ,(43,Plain 'h') + ,(44,Plain 'j') + ,(45,Plain 'k') + ,(46,Plain 'l') + ,(47,Plain ';') + ,(48,Plain '\'') + ,(36,RET) + ,(52,Plain 'z') + ,(53,Plain 'x') + ,(54,Plain 'c') + ,(55,Plain 'v') + ,(56,Plain 'b') + ,(57,Plain 'n') + ,(58,Plain 'm') + ,(59,Plain ',') + ,(60,Plain '.') + ,(61,Plain '/') + ,(66,CapsLock) + ,(49,Plain '`') + ,(10,Plain '1') + ,(11,Plain '2') + ,(12,Plain '3') + ,(13,Plain '4') + ,(14,Plain '5') + ,(15,Plain '6') + ,(16,Plain '7') + ,(17,Plain '8') + ,(18,Plain '9') + ,(19,Plain '0') + ,(20,Plain '-') + ,(21,Plain '=') + ,(65,SPC) + ,(67,F 1) + ,(68,F 2) + ,(69,F 3) + ,(70,F 4) + ,(71,F 5) + ,(72,F 6) + ,(73,F 7) + ,(74,F 8) + ,(75,F 9) + ,(76,F 10) + ,(95,F 11) + ,(96,F 12) + ,(9,Escape) + ,(22,Backspace) + ,(118,Insert) + ,(119,Delete) + ,(110,Home) + ,(112,Prior) + ,(117,Next) + ,(115,End) + ,(111,UpArr) + ,(116,DownArr) + ,(113,LeftArr) + ,(114,RightArr) + ,(135,Menu) + ,(107,PrintScreen) + ,(23,TAB)] + +-- | Mapping for shift keys. +shiftMapping :: [(Char,Char)] +shiftMapping = + [('a','A') + ,('b','B') + ,('c','C') + ,('d','D') + ,('e','E') + ,('f','F') + ,('g','G') + ,('h','H') + ,('i','I') + ,('j','J') + ,('k','K') + ,('l','L') + ,('m','M') + ,('n','N') + ,('o','O') + ,('p','P') + ,('q','Q') + ,('r','R') + ,('s','S') + ,('t','T') + ,('u','U') + ,('v','V') + ,('w','W') + ,('x','X') + ,('y','Y') + ,('z','Z') + ,(',','<') + ,('.','>') + ,('/','?') + ,(';',':') + ,('\'','"') + ,('\\','|') + ,(']','}') + ,('[','{') + ,('=','+') + ,('-','_') + ,('0',')') + ,('9','(') + ,('8','*') + ,('7','&') + ,('6','^') + ,('5','%') + ,('4','$') + ,('3','#') + ,('2','@') + ,('1','!') + ,('`','~')] + +-- | Render a list of combos in Emacs-style notation. +showEmacsCombos :: [Combo] -> String +showEmacsCombos = unwords . words . go + where go (x@(Combo mods key):xs) + | not (S.null (S.filter (not . flip elem shiftKeys) mods)) || + special key = " " <> showComboEmacs x <> " " <> go xs + go (x:xs) = showComboEmacs x <> go xs + go [] = mempty + +-- | Is the key special in some way? +special :: Key -> Bool +special (Plain{}) = False +special _ = True + +-- | Show a key combination in Emacs form. Handles display shifted +-- keys properly. +showComboEmacs :: Combo -> String +showComboEmacs (Combo mods key) = + concat (map showKeyEmacs + (if any (flip S.member mods) shiftKeys + then case key of + Plain c -> + case lookup c shiftMapping of + Nothing -> normal + Just shifted -> + toList (foldl (\s k -> + S.delete k s) + mods + shiftKeys) <> + [Plain shifted] + _ -> normal + else normal)) + where normal = + toList mods <> + [key] + +-- | Shift keys. +shiftKeys :: [Key] +shiftKeys = [ShiftL,ShiftR] + +-- | Modifier keys. +modifierKeys :: [Key] +modifierKeys = + [CtrlL,CtrlR,AltL,AltR,SuperL,SuperR,ShiftL,ShiftR] + +-- | Show a key for Emacs. +showKeyEmacs :: Key -> String +showKeyEmacs k = + case k of + CtrlL -> "C-" + CtrlR -> "C-" + AltL -> "M-" + AltR -> "M-" + Plain c -> + if c == '<' + then "< " -- Because notify-osd does not follow its + -- own rules properly. + else [c] + ShiftL -> "S-" + ShiftR -> "S-" + RET -> "RET" + SuperL -> "s-" + SuperR -> "s-" + SPC -> "SPC" + F i -> " show i <> ">" + Escape -> "" + CapsLock -> "" + Backspace -> "DEL" + Insert -> "" + Delete -> "" + Home -> "" + Prior -> "" + Next -> "" + End -> "" + UpArr -> "" + DownArr -> "" + LeftArr -> "" + RightArr -> "" + Menu -> "" + PrintScreen -> "" + TAB -> "TAB" + Unknown (KeyCode i) -> "?" <> show i diff --git a/src/OSDKeys/Types.hs b/src/OSDKeys/Types.hs new file mode 100644 --- /dev/null +++ b/src/OSDKeys/Types.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +-- | All types. + +module OSDKeys.Types where + +import Data.Sequence (Seq) +import Data.Set (Set) + +-- | Key processing state. +data State = + State {stateModifiers :: !(Set Key) + -- ^ Perhaps on some systems order of key press matters, but + -- this type assumes it doesn't. + ,stateCombos :: !(Seq Combo) + -- ^ A sequence of key combinations e.g. \"a\" \"C-f\", + -- \"Alt-DEL\", etc. + } + +-- | A combination of some modifiers and a key. +data Combo = Combo !(Set Key) !Key + deriving (Show) + +-- | An event. +data Event + = Press + | Release + deriving (Enum,Bounded,Eq,Show) + +-- | Key code. +newtype KeyCode = + KeyCode Int + deriving (Eq,Show,Num,Ord) + +-- | Device identifier. +newtype Device = Device Int + deriving (Num) + +-- | Well-typed key. +data Key + = CtrlL + | CtrlR + | AltL + | AltR + | ShiftL + | ShiftR + | RET + | SuperL + | SuperR + | CapsLock + | SPC + | F Int + | Escape + | Backspace + | Insert + | Delete + | Home + | Prior + | Next + | End + | UpArr + | DownArr + | LeftArr + | RightArr + | PrintScreen + | Menu + | TAB + | Plain Char + | Unknown KeyCode + deriving (Show,Ord,Eq) diff --git a/src/OSDKeys/XInput.hs b/src/OSDKeys/XInput.hs new file mode 100644 --- /dev/null +++ b/src/OSDKeys/XInput.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE LiberalTypeSynonyms #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ViewPatterns #-} + +-- | A conduit interface to XInput events. + +module OSDKeys.XInput + (xinputSource) + where + +import OSDKeys.Types + +import Control.Monad.IO.Class +import Control.Monad.Trans.Class +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as S8 +import Data.Conduit +import qualified Data.Conduit.Binary as CB +import qualified Data.Conduit.List as CL +import Data.Conduit.Process +import Data.Monoid +import System.Exit + +-- | Source of xinput keys. +xinputSource :: MonadIO m + => Device -> ConduitM i (Event,KeyCode) m ExitCode +xinputSource (Device device) = + do (exitCode,()) <- sourceCmdWithConsumer + ("unbuffer xinput test " <> show device) + (CB.lines $= CL.mapMaybe parse $= + awaitForever (lift . yield)) + return exitCode + +-- | Parse an xinput test line. +parse :: ByteString -> Maybe (Event,KeyCode) +parse line = + case S8.words (S8.drop 4 line) of + [mode,S8.readInt -> Just (code,_)] -> + return (if mode == "release" + then Release + else Press + ,KeyCode code) + _ -> Nothing diff --git a/src/main/Main.hs b/src/main/Main.hs new file mode 100644 --- /dev/null +++ b/src/main/Main.hs @@ -0,0 +1,37 @@ +-- | Main entry point to osdkeys. +-- +-- Show keys pressed with an on-screen display (Linux only) + +module Main where + +import Data.Maybe +import OSDKeys +import OSDKeys.Types +import System.Process + +import System.Environment +import Text.Read + +-- | Main entry point. +main :: IO () +main = + do args <- getArgs + case args of + [mdevice] -> run mdevice Nothing + [mdevice,mmax] -> run mdevice (Just mmax) + _ -> error "Arguments: DEVICE-ID []\n\n\ + \Use `xinput list' to get device ID." + +-- | Run on the device and with the given max. +run :: String -> Maybe String -> IO () +run mdevice mmax = + case readMaybe mdevice of + Nothing -> + do xinputOutput <- readProcess "xinput" + ["list"] + "" + error ("Need a device id. Here are the current devices: \n\n" ++ + xinputOutput) + Just device -> + startOSDKeys (Device device) + (fromMaybe 64 (mmax >>= readMaybe))