diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Revision history for boring-window-switcher + +## 0.1.0.0 -- 2016-06-28 + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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 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/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,5 @@ +module Main + (main) where + +import Graphics.UI.BoringWindowSwitcher (main) + diff --git a/author-test/Graphics/UI/BoringWindowSwitcher/Internal/ControlSpec.hs b/author-test/Graphics/UI/BoringWindowSwitcher/Internal/ControlSpec.hs new file mode 100644 --- /dev/null +++ b/author-test/Graphics/UI/BoringWindowSwitcher/Internal/ControlSpec.hs @@ -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.") + diff --git a/author-test/Spec.hs b/author-test/Spec.hs new file mode 100644 --- /dev/null +++ b/author-test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/boring-window-switcher.cabal b/boring-window-switcher.cabal new file mode 100644 --- /dev/null +++ b/boring-window-switcher.cabal @@ -0,0 +1,60 @@ +name: boring-window-switcher +version: 0.1.0.0 +author: Toshio Ito +maintainer: Toshio Ito +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 diff --git a/src/Graphics/UI/BoringWindowSwitcher.hs b/src/Graphics/UI/BoringWindowSwitcher.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/UI/BoringWindowSwitcher.hs @@ -0,0 +1,31 @@ +-- | +-- Module: Graphics.UI.BoringWindowSwitcher +-- Description: main module behind boring-window-switcher +-- Maintainer: Toshio Ito +-- +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 diff --git a/src/Graphics/UI/BoringWindowSwitcher/Internal/Control.hs b/src/Graphics/UI/BoringWindowSwitcher/Internal/Control.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/UI/BoringWindowSwitcher/Internal/Control.hs @@ -0,0 +1,88 @@ +-- | +-- Module: Graphics.UI.BoringWindowSwitcher.Internal.Control +-- Description: Controls windows. +-- Maintainer: Toshio Ito +-- +-- 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 + diff --git a/src/Graphics/UI/BoringWindowSwitcher/Internal/Dialog.hs b/src/Graphics/UI/BoringWindowSwitcher/Internal/Dialog.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/UI/BoringWindowSwitcher/Internal/Dialog.hs @@ -0,0 +1,55 @@ +-- | +-- Module: Graphics.UI.BoringWindowSwitcher.Internal.Dialog +-- Description: Dialog UI. +-- Maintainer: Toshio Ito +-- +-- 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 + +