-- Author: Andy Stewart -- Maintainer: Andy Stewart -- -- Copyright (C) 2010 ~ 2011 Andy Stewart, all rights reserved. -- -- This program is free software: you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation, either version 3 of the License, or -- any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . {-# LANGUAGE OverloadedStrings #-} module Manatee.Toolkit.Widget.KeymapWindow where import Control.Applicative import Control.Monad import Data.Text.Lazy (Text, unpack) import Graphics.UI.Gtk import Manatee.Toolkit.Gtk.Container import Manatee.Toolkit.Gtk.Gtk data KeymapWindow = KeymapWindow {kwWindow :: Window ,kwScrolledWindow :: ScrolledWindow ,kwBox :: VBox } -- | Application name column id. columnId = makeColumnIdString 0 -- | Keymap window new. keymapWindowNew :: IO KeymapWindow keymapWindowNew = do -- Init. window <- windowNewPopup set window [windowTypeHint := WindowTypeHintDialog ,windowDecorated := False ,windowAcceptFocus := False ,windowResizable := True -- this make window can smaller than last size ,windowOpacity := 0.9 ] scrolledWindow <- scrolledWindowNew Nothing Nothing scrolledWindowSetPolicy scrolledWindow PolicyNever PolicyAutomatic box <- vBoxNew False 0 -- Connect widgets. connectWidgets [castToContainer window] scrolledWindow scrolledWindowAddWithViewport scrolledWindow box return $ KeymapWindow window scrolledWindow box -- | Show keymap window. keymapWindowShow :: WidgetClass widget => KeymapWindow -> widget -- module widget -> Rectangle -- position and size -> [(String, [(Text, Text)])] -- keymap -> IO () keymapWindowShow (KeymapWindow {kwWindow = window ,kwBox = box}) widget (Rectangle x y w h) keymap = do -- Set transient window. castToWindow <$> widgetGetToplevel widget >>= windowSetTransientFor window -- Set window position and size. windowMove window x y widgetSetSizeRequest window w h windowResize window w h -- Add keymap. forM_ keymap $ \ (keymapTitle, list) -> do -- Add keymap title. label <- labelNew Nothing labelSetMarkup label ("" ++ keymapTitle ++ "") boxPackStart box label PackNatural 0 -- Add keymap content. let items = map (\ (key, command) -> "" ++ concatMap (\c -> if c == ' ' then "Space" else [c]) (unpack key) ++ "" ++ " " ++ unpack command ++ "") list store <- listStoreNew items customStoreSetColumn store columnId id iconView <- iconViewNewWithModel store iconViewSetMarkupColumn iconView columnId widgetModifyBase iconView StateNormal (Color 15360 15104 14080) boxPackStart box iconView PackGrow 0 -- Show. widgetShowAll window -- | Hide keymap window. keymapWindowHide :: KeymapWindow -> IO () keymapWindowHide view = do widgetHide $ kwWindow view containerRemoveAll $ kwBox view -- | Is visible. keymapWindowIsVisible :: KeymapWindow -> IO Bool keymapWindowIsVisible win = get (kwWindow win) widgetVisible -- | Exit. keymapWindowExit :: KeymapWindow -> IO () keymapWindowExit = widgetDestroy . kwWindow