packages feed

boring-window-switcher (empty) → 0.1.0.0

raw patch · 11 files changed

+338/−0 lines, 11 filesdep +X11dep +basedep +boring-window-switchersetup-changed

Dependencies added: X11, base, boring-window-switcher, gtk, hspec, transformers

Files

+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for boring-window-switcher++## 0.1.0.0  -- 2016-06-28++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2016, Toshio Ito++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 Toshio Ito nor the names of other+      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 THE COPYRIGHT+OWNER OR CONTRIBUTORS 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.
+ README.md view
@@ -0,0 +1,30 @@+# boring-window-switcher++![screen shot](https://raw.githubusercontent.com/debug-ito/boring-window-switcher/master/resource/screenshot.png)++A boring window switcher for X11 desktop environments.++Unlike many other window switchers, this is NOT a daemon. This is just a regular Gtk+ application that shows windows currently open, and raises the window the user selects. It does not do any tricky keyboard grabbing.+++## How to Install++TBW. (It's a Haskell program installable by `cabal`).++## How to Run++ $ boring-window-switcher++## See Also++Probably you should use other feature-rich window switchers.++- [Rofi](https://davedavenport.github.io/rofi/)+- [seanpringle/simpleswitcher](https://github.com/seanpringle/simpleswitcher)+- [Frenzie/nimbler: A window switcher for users who keep a lot of windows open on multiple workspaces.](https://github.com/Frenzie/nimbler)+- [AdamCDunlap/telescope: Simple window switcher](https://github.com/AdamCDunlap/telescope)+++## Author++Toshio Ito <debug.ito@gmail.com>
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,5 @@+module Main+       (main) where++import Graphics.UI.BoringWindowSwitcher (main)+
+ author-test/Graphics/UI/BoringWindowSwitcher/Internal/ControlSpec.hs view
@@ -0,0 +1,31 @@+module Graphics.UI.BoringWindowSwitcher.Internal.ControlSpec (main,spec) where++import System.IO (stderr, hPutStrLn)+import Test.Hspec++import Graphics.UI.BoringWindowSwitcher.Internal.Control+  ( withControl, selectableWindows,+    raiseWindow+  )+++main :: IO ()+main = hspec spec++spec :: Spec+spec = describe "Control" $ do+  describe "selectableWindows" $ do+    it "returns one or more Windows" $ withControl $ \control -> do+      win_list <- selectableWindows control+      hPutStrLn stderr $ show win_list+      length win_list `shouldSatisfy` (>= 1)+  describe "raiseWindow" $ do+    it "raises the selected window" $ withControl $ \control -> do+      win_list <- selectableWindows control+      case win_list of+        (_ : second_win : _) -> do+          hPutStrLn stderr ("Raise " ++ show second_win)+          raiseWindow control second_win+        _ -> do+          hPutStrLn stderr ("Not enough windows. Skipped.")+
+ author-test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ boring-window-switcher.cabal view
@@ -0,0 +1,60 @@+name:                   boring-window-switcher+version:                0.1.0.0+author:                 Toshio Ito <debug.ito@gmail.com>+maintainer:             Toshio Ito <debug.ito@gmail.com>+license:                BSD3+license-file:           LICENSE+synopsis:               A boring window switcher.+description:            A boring window switcher. See README.md+category:               Graphics+cabal-version:          >= 1.10+build-type:             Simple+extra-source-files:     README.md, ChangeLog.md+homepage:               https://github.com/debug-ito/boring-window-switcher+bug-reports:            https://github.com/debug-ito/boring-window-switcher/issues++library+  default-language:     Haskell2010+  hs-source-dirs:       src+  ghc-options:          -Wall -fno-warn-unused-imports+  -- default-extensions:   +  -- other-extensions:     +  exposed-modules:      Graphics.UI.BoringWindowSwitcher,+                        Graphics.UI.BoringWindowSwitcher.Internal.Control,+                        Graphics.UI.BoringWindowSwitcher.Internal.Dialog+  build-depends:        base >=4.7.0 && <5.0,+                        X11 >=1.6.1 && <1.7,+                        transformers >=0.3.0 && <0.6,+                        gtk >=0.13.9 && <0.15++executable boring-window-switcher+  default-language:     Haskell2010+  hs-source-dirs:       app+  main-is:              Main.hs+  ghc-options:          -Wall -fno-warn-unused-imports+  -- other-modules:        +  -- default-extensions:   +  -- other-extensions:     +  build-depends:        base, boring-window-switcher++flag author-test+  default: False+  description: Run test only for authors.++test-suite author-spec+  type:                 exitcode-stdio-1.0+  default-language:     Haskell2010+  hs-source-dirs:       author-test+  ghc-options:          -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m"+  main-is:              Spec.hs+  if !flag(author-test)+    buildable: False+  -- default-extensions:   +  -- other-extensions:     +  other-modules:        Graphics.UI.BoringWindowSwitcher.Internal.ControlSpec+  build-depends:        base, boring-window-switcher,+                        hspec >=2.1.7 && <2.3++source-repository head+  type:                 git+  location:             https://github.com/debug-ito/boring-window-switcher.git
+ src/Graphics/UI/BoringWindowSwitcher.hs view
@@ -0,0 +1,31 @@+-- |+-- Module: Graphics.UI.BoringWindowSwitcher+-- Description: main module behind boring-window-switcher+-- Maintainer: Toshio Ito <debug.ito@gmail.com>+-- +module Graphics.UI.BoringWindowSwitcher+       (main) where++import Control.Monad (void)+import Control.Monad.IO.Class (liftIO)+import Graphics.UI.BoringWindowSwitcher.Internal.Control+  ( withControl, selectableWindows, raiseWindow+  )+import Graphics.UI.BoringWindowSwitcher.Internal.Dialog (createDialog)++import qualified Graphics.UI.Gtk as Gtk++-- | Entry point of @boring-window-switcher@ executable.+main :: IO ()+main = do+  void $ Gtk.initGUI+  withControl $ \control -> do+    wins <- selectableWindows control+    dialog <- createDialog wins $ \selected_window -> do+      raiseWindow control selected_window+      Gtk.mainQuit+    void $ Gtk.on dialog Gtk.deleteEvent $ do+      liftIO $ Gtk.mainQuit+      return False+    Gtk.widgetShowAll dialog+    Gtk.mainGUI
+ src/Graphics/UI/BoringWindowSwitcher/Internal/Control.hs view
@@ -0,0 +1,88 @@+-- |+-- Module: Graphics.UI.BoringWindowSwitcher.Internal.Control+-- Description: Controls windows.+-- Maintainer: Toshio Ito <debug.ito@gmail.com>+--+-- This is an internal module. End-users should not use this.+module Graphics.UI.BoringWindowSwitcher.Internal.Control+       ( Control, withControl,+         Window, windowName, selectableWindows, raiseWindow+       ) where++import Control.Applicative ((<|>), (<$>))+import Control.Exception (bracket)+import Control.Monad (mapM, guard, filterM)+import Control.Monad.Trans.Maybe (MaybeT(..))+import Control.Monad.IO.Class (liftIO)+import Data.Maybe (listToMaybe)+import qualified Graphics.X11.Xlib as Xlib+import qualified Graphics.X11.Xlib.Extras as XlibE++newtype Control = Control { controlDisplay :: Xlib.Display }++withControl :: (Control -> IO a) -> IO a+withControl = bracket (Control <$> Xlib.openDisplay "") (Xlib.closeDisplay . controlDisplay)++data Window = Window { windowID :: !Xlib.Window,+                       windowName :: !String+                     } deriving (Show,Eq,Ord)++toOurWindow :: Xlib.Display -> Xlib.Window -> IO Window+toOurWindow disp wid = Window wid <$> xGetWindowName disp wid++withDefaultOf :: Functor m => a -> MaybeT m a -> m a+withDefaultOf def_value = (fmap $ maybe def_value id) . runMaybeT++-- | c.f. @xdo_get_window_name@ function in libxdo-2.+xGetWindowName :: Xlib.Display -> Xlib.Window -> IO String+xGetWindowName disp win = withDefaultOf "" $ propAt "_NET_WM_NAME" <|> propAt "WM_NAME"+  where+    propAt prop_name_str = do+      prop_name_atom <- liftIO $ Xlib.internAtom disp prop_name_str False+      tprop <- liftIO $ XlibE.getTextProperty disp win prop_name_atom+      guard (XlibE.tp_nitems tprop > 0)+      MaybeT $ listToMaybe <$> XlibE.wcTextPropertyToTextList disp tprop++selectableWindows :: Control -> IO [Window]+selectableWindows cont = mapM (toOurWindow disp) =<< xSelectableWindows disp where+  disp = controlDisplay cont++nothingToExcept :: String -> MaybeT IO a -> IO a+nothingToExcept error_message m = maybe (fail error_message) return =<< runMaybeT m++-- | c.f. @getWindowList@ function in+-- https://github.com/debug-ito/numpaar/blob/master/src/window_utils.c+-- , which is based on the source code of wmctrl and libxdo-2.+xSelectableWindows :: Xlib.Display -> IO [Xlib.Window]+xSelectableWindows disp = filterM (xIsWindowForPager disp) =<< allWindows+  where+    allWindows = nothingToExcept "Cannot obtain X client list."+                 $ winsFor "_NET_CLIENT_LIST_STACKING"+                 <|> winsFor "_NET_CLIENT_LIST"+                 <|> winsFor "_WIN_CLIENT_LIST"+    winsFor request = do+      req_atom <- liftIO $ Xlib.internAtom disp request False+      raw_list <- (fmap . map) fromIntegral $ MaybeT $ XlibE.getWindowProperty32 disp req_atom (Xlib.defaultRootWindow disp)+      return $ reverse raw_list++-- | c.f. @isWindowForPager@ function in+-- https://github.com/debug-ito/numpaar/blob/master/src/interpreter.c+xIsWindowForPager :: Xlib.Display -> Xlib.Window -> IO Bool+xIsWindowForPager disp win = impl where+  impl = do+    state_req <- Xlib.internAtom disp "_NET_WM_STATE" False+    mret <- XlibE.getWindowProperty32 disp state_req win+    case mret of+      Nothing -> return True+      Just raw_atoms -> do+        let state_atoms = map fromIntegral raw_atoms+        skip_atom <- Xlib.internAtom disp "_NET_WM_STATE_SKIP_PAGER" False+        return $ not $ skip_atom `elem` state_atoms++raiseWindow :: Control -> Window -> IO ()+raiseWindow cont win = do+  Xlib.raiseWindow disp wid+  where+    disp = controlDisplay cont+    wid = windowID win+
+ src/Graphics/UI/BoringWindowSwitcher/Internal/Dialog.hs view
@@ -0,0 +1,55 @@+-- |+-- Module: Graphics.UI.BoringWindowSwitcher.Internal.Dialog+-- Description: Dialog UI. +-- Maintainer: Toshio Ito <debug.ito@gmail.com>+--+-- This is an internal module. End-users should not use this.+module Graphics.UI.BoringWindowSwitcher.Internal.Dialog+       ( createDialog+       ) where++import Control.Monad (void, guard, when)+import Data.Maybe (listToMaybe)+import qualified Graphics.UI.Gtk as Gtk+import Graphics.UI.Gtk (AttrOp((:=)))++import Graphics.UI.BoringWindowSwitcher.Internal.Control+  ( Window, windowName+  )++createDialog :: [Window] -- ^ the list of windows to show.+             -> (Window -> IO ()) -- ^ callback on the selected window.+             -> IO Gtk.Window+createDialog wins on_selected = do+  dialog_window <- Gtk.windowNew+  Gtk.set dialog_window [Gtk.windowTitle := "Boring Window Switcher"]+  wlist <- createWindowList wins on_selected+  Gtk.containerAdd dialog_window wlist+  return dialog_window++createWindowList :: [Window] -> (Window -> IO ()) -> IO Gtk.TreeView+createWindowList wins on_selected = impl where+  impl = do+    model <- Gtk.listStoreNew wins+    view <- Gtk.treeViewNewWithModel model+    Gtk.treeViewSetHeadersVisible view False+    void $ Gtk.treeViewAppendColumn view =<< makeWinNameColumn model+    void $ Gtk.on view Gtk.rowActivated $ \path _ ->+      maybe (return ()) on_selected $ getRowItem wins path+    when (length wins > 0) $ Gtk.treeViewSetCursor view [(min 1 (length wins - 1))] Nothing+    return view+  makeWinNameColumn win_model = do+    col <- Gtk.treeViewColumnNew+    Gtk.set col [Gtk.treeViewColumnTitle := "Window Name"]+    renderer <- Gtk.cellRendererTextNew+    -- see https://wiki.haskell.org/Gtk2Hs/Tutorials/TreeView+    Gtk.cellLayoutPackStart col renderer False+    Gtk.cellLayoutSetAttributes col renderer win_model $ \win ->+      [Gtk.cellText := windowName win]+    return col+  getRowItem rows indices = do+    index <- listToMaybe indices+    guard (0 <= index && index < length rows)+    return $ rows !! index+  +