packages feed

osdkeys (empty) → 0.0

raw patch · 8 files changed

+526/−0 lines, 8 filesdep +basedep +bytestringdep +conduitsetup-changed

Dependencies added: base, bytestring, conduit, conduit-extra, containers, libnotify, osdkeys, process, resourcet, time, transformers

Files

+ LICENSE view
@@ -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 <COPYRIGHT HOLDER> 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ osdkeys.cabal view
@@ -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
+ src/OSDKeys.hs view
@@ -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 =+  [('&',"&amp;")+  ,('<',"&lt;")+  ,('>',"&gt;")+  ,('\'',"&apos;")+  ,('"',"&quot;")]
+ src/OSDKeys/Mappings.hs view
@@ -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 -> "<f" <> show i <> ">"+    Escape -> "<escape>"+    CapsLock -> "<capslock>"+    Backspace -> "DEL"+    Insert -> "<insert>"+    Delete -> "<delete>"+    Home -> "<home>"+    Prior -> "<prior>"+    Next -> "<next>"+    End -> "<end>"+    UpArr -> "<up>"+    DownArr -> "<down>"+    LeftArr -> "<left>"+    RightArr -> "<right>"+    Menu -> "<menu>"+    PrintScreen -> "<printscreen>"+    TAB -> "TAB"+    Unknown (KeyCode i) -> "?" <> show i
+ src/OSDKeys/Types.hs view
@@ -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)
+ src/OSDKeys/XInput.hs view
@@ -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
+ src/main/Main.hs view
@@ -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 [<max-keys-on-screen>]\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))