diff --git a/src/Collection.hs b/src/Collection.hs --- a/src/Collection.hs +++ b/src/Collection.hs @@ -45,20 +45,20 @@ browseCollection maybeName = do - let f = browseCollection + builder <- makeBuilder "collection-browser" - context <- initUI - let ?context = context + let f = browseCollection context <- initModel let ?context = context - context <- initView + context <- initView builder let ?context = context - context <- initCollectionUI f + context <- initUI builder let ?context = context + setupUI builder f setupDnD widgetShowAll window diff --git a/src/Collection/List/View.hs b/src/Collection/List/View.hs --- a/src/Collection/List/View.hs +++ b/src/Collection/List/View.hs @@ -48,12 +48,14 @@ listSel = vSel context -initListView = do - context <- initContext +initListView builder = do + context <- initContext builder let ?context = context treeSelectionSetMode listSel SelectionBrowse + treeViewSetModel listView listStore + treeViewSetHeadersVisible listView False widgetSetSizeRequest listView 200 (-1) @@ -80,8 +82,8 @@ treeViewSetCursor listView [0] Nothing -initContext = do - view <- treeViewNewWithModel listStore +initContext builder = do + view <- builderGetObject builder castToTreeView "list-view" sel <- treeViewGetSelection view return $ augmentContext View { vView = view diff --git a/src/Collection/UI.hs b/src/Collection/UI.hs --- a/src/Collection/UI.hs +++ b/src/Collection/UI.hs @@ -18,7 +18,7 @@ -- module Collection.UI - ( initCollectionUI + ( setupUI ) where import Control.Applicative @@ -34,11 +34,9 @@ import XMMS import Handler import Utils -import Context import Properties ( showPropertyImport , showPropertyManager - , OrderDialog , makeOrderDialog , showOrderDialog ) import Compound @@ -47,65 +45,71 @@ import Collection.Control -data CollectionUI - = CollectionUI { cOrderDialog :: OrderDialog } - -orderDialog = cOrderDialog context - - -initCollectionUI browse = do - context <- initContext +setupUI builder browse = do + context <- initListView builder let ?context = context - addUIActions $ uiActions browse + setupActions builder browse + setupConnection builder - srvAG <- actionGroupNew "server" - actionGroupAddActions srvAG $ srvActions browse - onServerConnectionAdd . ever $ actionGroupSetSensitive srvAG - insertActionGroup srvAG 1 + collFilter `onEntryActivate` applyFilter + collFilter `onIconPress` \icon -> + case icon of + PrimaryIcon -> entrySetText collFilter "" + SecondaryIcon -> applyFilter - addUIFromFile "collection-browser" + popup <- getWidget castToMenu "ui/collection-popup" + setupTreeViewPopup collView popup onCollectionActivated loadSelected onCollectionListMidClick $ browseSelected browse onCollectionListCR $ browseSelected browse - paned <- hPanedNew - boxPackStartDefaults contents paned - - scroll <- scrolledWindowNew Nothing Nothing - scrolledWindowSetPolicy scroll PolicyAutomatic PolicyAutomatic - scrolledWindowSetShadowType scroll ShadowIn - containerAdd scroll listView - panedAdd1 paned scroll - - box <- vBoxNew False 5 - panedAdd2 paned box - - boxPackStart box collFilter PackNatural 0 - collFilter `onEntryActivate` applyFilter + popup <- getWidget castToMenu "ui/list-popup" + setupTreeViewPopup listView popup - scroll <- scrolledWindowNew Nothing Nothing - scrolledWindowSetPolicy scroll PolicyAutomatic PolicyAutomatic - scrolledWindowSetShadowType scroll ShadowIn - containerAdd scroll collView - boxPackStartDefaults box scroll + return () - popup <- getWidget castToMenu "ui/collection-popup" - setupTreeViewPopup collView popup +setupActions builder browse = do + orderDialog <- unsafeInterleaveIO $ makeOrderDialog $ \v -> do + let outerw = outer v + windowSetTitle outerw "Configure ordering" + windowSetDefaultSize outerw 500 400 - popup <- getWidget castToMenu "ui/list-popup" - setupTreeViewPopup listView popup + bindActions builder + [ ("new-window" , newWindow browse ) + , ("edit-filter" , editFilter ) + , ("all-media" , allMedia ) + , ("configure-columns" , showViewConfigDialog ) + , ("configure-ordering" , showOrderDialog orderDialog getOrder setOrder) + , ("manage-properties" , showPropertyManager ) + , ("browse-in-new-window" , browseSelected browse ) + , ("save-collection" , saveCollection ) + , ("rename-collection" , renameCollection ) + , ("delete-collection" , removeCollection ) + , ("add-to-playlist" , addToPlaylist False ) + , ("replace-playlist" , addToPlaylist True ) + , ("coll-add-to-playlist" , collAddToPlaylist False ) + , ("coll-replace-playlist" , collAddToPlaylist True ) + , ("list-add-to-playlist" , listAddToPlaylist False ) + , ("list-replace-playlist" , listAddToPlaylist True ) + , ("copy" , editCopy ) + , ("select-all" , editSelectAll ) + , ("invert-selection" , editInvertSelection ) + , ("edit-properties" , showPropertyEditor ) + , ("export-properties" , showPropertyExport ) + , ("import-properties" , showPropertyImport ) + ] - acts <- mapM (getAction srvAG) + acts <- actions builder [ "rename-collection" - , "remove-collection" + , "delete-collection" ] onCollectionSelectionChanged $ do en <- isJust <$> getSelectedCollection mapM_ (`actionSetSensitive` en) acts - acts <- mapM (getAction srvAG) + acts <- actions builder [ "add-to-playlist" , "replace-playlist" ] @@ -119,254 +123,33 @@ w `on` focusOutEvent $ updatePA setupPA listView setupPA collView - updatePA - acts <- mapM (getAction srvAG) - ["copy", "edit-properties", "export-properties"] - let updateE = do + acts <- actions builder + [ "copy" + , "edit-properties" + , "export-properties" + ] + let updateEdit = do en <- (/= 0) <$> treeSelectionCountSelectedRows collSel mapM_ (`actionSetSensitive` en) acts - collSel `onSelectionChanged` updateE - updateE - - updateWindowTitle - return ?context - - -initContext = do - context <- initListView - let ?context = context + collSel `onSelectionChanged` updateEdit - orderDialog <- unsafeInterleaveIO $ makeOrderDialog $ \v -> do - let outerw = outer v - windowSetTitle outerw "Configure ordering" - windowSetDefaultSize outerw 500 400 + flip timeoutAdd 0 $ do + updatePA + updateEdit + updateWindowTitle + return False - return $ augmentContext - CollectionUI { cOrderDialog = orderDialog } + return () +setupConnection builder = do + ag <- builderGetObject builder castToActionGroup "server-actions" -uiActions browse = - [ ActionEntry - { actionEntryName = "collection" - , actionEntryLabel = "_Collection" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = return () - } - , ActionEntry - { actionEntryName = "new-window" - , actionEntryLabel = "_New window" - , actionEntryStockId = Just stockNew - , actionEntryAccelerator = Just "n" - , actionEntryTooltip = Nothing - , actionEntryCallback = newWindow browse - } - , ActionEntry - { actionEntryName = "edit-filter" - , actionEntryLabel = "_Edit filter" - , actionEntryStockId = Just stockEdit - , actionEntryAccelerator = Just "l" - , actionEntryTooltip = Nothing - , actionEntryCallback = editFilter - } - , ActionEntry - { actionEntryName = "all-media" - , actionEntryLabel = "A_ll media" - , actionEntryStockId = Just stockNew - , actionEntryAccelerator = Just "u" - , actionEntryTooltip = Nothing - , actionEntryCallback = allMedia - } - , ActionEntry - { actionEntryName = "edit" - , actionEntryLabel = "_Edit" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = return () - } - , ActionEntry - { actionEntryName = "view" - , actionEntryLabel = "_View" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = return () - } - , ActionEntry - { actionEntryName = "configure-columns" - , actionEntryLabel = "Configure _columns" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = showViewConfigDialog - } - , ActionEntry - { actionEntryName = "configure-ordering" - , actionEntryLabel = "Configure _ordering" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = showOrderDialog orderDialog getOrder setOrder - } - , ActionEntry - { actionEntryName = "properties" - , actionEntryLabel = "P_roperties" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = return () - } - , ActionEntry - { actionEntryName = "manage-properties" - , actionEntryLabel = "_Manage properties" - , actionEntryStockId = Just stockPreferences - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = showPropertyManager - } - , ActionEntry - { actionEntryName = "collection-popup" - , actionEntryLabel = "" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = return () - } - ] + onServerConnectionAdd . ever $ \conn -> do + actionGroupSetSensitive ag conn + collFilter `set` [ secondaryIconSensitive := conn ] -srvActions browse = - [ ActionEntry - { actionEntryName = "browse-in-new-window" - , actionEntryLabel = "_Browse in new window" - , actionEntryStockId = Just stockOpen - , actionEntryAccelerator = Just "Return" - , actionEntryTooltip = Nothing - , actionEntryCallback = browseSelected browse - } - , ActionEntry - { actionEntryName = "save-collection" - , actionEntryLabel = "_Save collection" - , actionEntryStockId = Just stockSave - , actionEntryAccelerator = Just "s" - , actionEntryTooltip = Nothing - , actionEntryCallback = saveCollection - } - , ActionEntry - { actionEntryName = "rename-collection" - , actionEntryLabel = "Rena_me collection" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = renameCollection - } - , ActionEntry - { actionEntryName = "remove-collection" - , actionEntryLabel = "Remo_ve collection" - , actionEntryStockId = Just stockDelete - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = removeCollection - } - , ActionEntry - { actionEntryName = "add-to-playlist" - , actionEntryLabel = "_Add to playlist" - , actionEntryStockId = Just stockAdd - , actionEntryAccelerator = Just "p" - , actionEntryTooltip = Nothing - , actionEntryCallback = addToPlaylist False - } - , ActionEntry - { actionEntryName = "replace-playlist" - , actionEntryLabel = "_Replace playlist" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Just "p" - , actionEntryTooltip = Nothing - , actionEntryCallback = addToPlaylist True - } - , ActionEntry - { actionEntryName = "coll-add-to-playlist" - , actionEntryLabel = "_Add to playlist" - , actionEntryStockId = Just stockAdd - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = collAddToPlaylist False - } - , ActionEntry - { actionEntryName = "coll-replace-playlist" - , actionEntryLabel = "_Replace playlist" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = collAddToPlaylist True - } - , ActionEntry - { actionEntryName = "list-add-to-playlist" - , actionEntryLabel = "_Add to playlist" - , actionEntryStockId = Just stockAdd - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = listAddToPlaylist False - } - , ActionEntry - { actionEntryName = "list-replace-playlist" - , actionEntryLabel = "_Replace playlist" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = listAddToPlaylist True - } - , ActionEntry - { actionEntryName = "copy" - , actionEntryLabel = "_Copy" - , actionEntryStockId = Just stockCopy - , actionEntryAccelerator = Just "c" - , actionEntryTooltip = Nothing - , actionEntryCallback = editCopy - } - , ActionEntry - { actionEntryName = "select-all" - , actionEntryLabel = "_Select all" - , actionEntryStockId = Just stockSelectAll - , actionEntryAccelerator = Just "a" - , actionEntryTooltip = Nothing - , actionEntryCallback = editSelectAll - } - , ActionEntry - { actionEntryName = "invert-selection" - , actionEntryLabel = "_Invert selection" - , actionEntryStockId = Just stockSelectAll - , actionEntryAccelerator = Just "a" - , actionEntryTooltip = Nothing - , actionEntryCallback = editInvertSelection - } - , ActionEntry - { actionEntryName = "edit-properties" - , actionEntryLabel = "_Edit properties" - , actionEntryStockId = Just stockEdit - , actionEntryAccelerator = Just "Return" - , actionEntryTooltip = Nothing - , actionEntryCallback = showPropertyEditor - } - , ActionEntry - { actionEntryName = "export-properties" - , actionEntryLabel = "E_xport properties" - , actionEntryStockId = Just stockSave - , actionEntryAccelerator = Just "" - , actionEntryTooltip = Nothing - , actionEntryCallback = showPropertyExport - } - , ActionEntry - { actionEntryName = "import-properties" - , actionEntryLabel = "_Import properties" - , actionEntryStockId = Just stockOpen - , actionEntryAccelerator = Just "" - , actionEntryTooltip = Nothing - , actionEntryCallback = showPropertyImport - } - ] + return () newWindow browse = diff --git a/src/Collection/View.hs b/src/Collection/View.hs --- a/src/Collection/View.hs +++ b/src/Collection/View.hs @@ -64,10 +64,11 @@ columns = vColumns context -initView = do - context <- initContext +initView builder = do + context <- initContext builder let ?context = context + treeViewSetModel collView collStore treeViewSetRulesHint collView True treeSelectionSetMode collSel SelectionMultiple @@ -81,10 +82,10 @@ (setColumns True . map fst) False window -initContext = do - view <- treeViewNewWithModel collStore +initContext builder = do + view <- builderGetObject builder castToTreeView "collection-view" sel <- treeViewGetSelection view - filter <- entryNew + filter <- builderGetObject builder castToEntry "filter-entry" configDlg <- unsafeInterleaveIO makeConfigDlg columns <- newIORef [] return $ augmentContext diff --git a/src/Environment.hs b/src/Environment.hs --- a/src/Environment.hs +++ b/src/Environment.hs @@ -25,6 +25,7 @@ , homeDir , dataDir , uiFilePath + , gladeFilePath , xmmsPath , maybeGetEnv ) where @@ -64,4 +65,5 @@ (Just <$> getEnv var) `catch` \_ -> return Nothing uiFilePath name = dataDir "ui" name <.> "xml" +gladeFilePath name = dataDir "ui" name <.> "glade" diff --git a/src/Location.hs b/src/Location.hs --- a/src/Location.hs +++ b/src/Location.hs @@ -40,16 +40,18 @@ browseLocation order maybeURL = do let f = browseLocation - context <- initUI - let ?context = context + builder <- makeBuilder "location-browser" context <- initModel order let ?context = context - context <- initView + context <- initView builder let ?context = context - setupUI f + context <- initUI builder + let ?context = context + + setupUI builder f setupDnD widgetShowAll window diff --git a/src/Location/UI.hs b/src/Location/UI.hs --- a/src/Location/UI.hs +++ b/src/Location/UI.hs @@ -36,41 +36,37 @@ import Location.Control -setupUI browse = do - addUIActions $ uiActions browse - - srvAG <- actionGroupNew "server" - actionGroupAddActions srvAG $ srvActions browse - onServerConnectionAdd . ever $ actionGroupSetSensitive srvAG - insertActionGroup srvAG 1 - - addUIFromFile "location-browser" - - toolbar <- getWidget castToToolbar "ui/toolbar" - toolbarSetStyle toolbar ToolbarIcons - boxPackStart contents toolbar PackNatural 0 - - item <- toolItemNew - toolItemSetHomogeneous item False - toolItemSetExpand item True - containerAdd item locationEntry - toolbarInsert toolbar item 6 - - load <- getAction srvAG "load" - locationEntry `onEntryActivate` actionActivate load +setupUI builder browse = do + setupActions builder browse + setupToolbar builder + setupLocationEntry builder + setupLocationView builder + setupConnection builder - scroll <- scrolledWindowNew Nothing Nothing - scrolledWindowSetPolicy scroll PolicyAutomatic PolicyAutomatic - containerAdd scroll locationView - boxPackStartDefaults contents scroll +setupActions builder browse = do + bindActions builder + [ ("new-window" , newWindow browse ) + , ("open-location" , openLocation ) + , ("load" , loadCurrentLocation ) + , ("down" , loadAtCursor (loadLocation . Go)) + , ("browse-in-new-window" , browseInNewWindow browse ) + , ("add-to-playlist" , addToPlaylist ) + , ("replace-playlist" , replacePlaylist ) + , ("back" , loadLocation Back ) + , ("forward" , loadLocation Forward ) + , ("up" , loadLocation Up ) + , ("refresh" , loadLocation Refresh ) + ] - popup <- getWidget castToMenu "ui/location-popup" - setupTreeViewPopup locationView popup + down <- action builder "down" + binw <- action builder "browse-in-new-window" + addp <- action builder "add-to-playlist" + repp <- action builder "replace-playlist" + back <- action builder "back" + forward <- action builder "forward" + up <- action builder "up" + refresh <- action builder "refresh" - down <- getAction srvAG "down" - binw <- getAction srvAG "browse-in-new-window" - addp <- getAction srvAG "add-to-playlist" - repp <- getAction srvAG "replace-playlist" let updateB = do rows <- treeSelectionGetSelectedRows locationSel (enp, enn) <- case rows of @@ -83,12 +79,59 @@ return (True, False) mapM_ (`actionSetSensitive` enp) [addp, repp] mapM_ (`actionSetSensitive` enn) [down, binw] + updateN = do + (eb, ef, eu, er) <- canGo + actionSetSensitive back eb + actionSetSensitive forward ef + actionSetSensitive up eu + actionSetSensitive refresh er + locationSel `onSelectionChanged` updateB - updateB + onLocation . add . ever . const $ updateN + flip timeoutAdd 0 $ do + updateB + updateN + updateWindowTitle + return False + return () + +setupToolbar builder = do + toolbar <- builderGetObject builder castToToolbar "toolbar" + + item <- separatorToolItemNew + separatorToolItemSetDraw item False + toolbarInsert toolbar item 4 + + item <- toolItemNew + toolItemSetHomogeneous item False + toolItemSetExpand item True + containerAdd item locationEntry + toolbarInsert toolbar item 5 + + item <- separatorToolItemNew + separatorToolItemSetDraw item False + toolbarInsert toolbar item 6 + +setupLocationEntry builder = do + load <- action builder "load" + locationEntry `onEntryActivate` actionActivate load + locationEntry `onIconPress` \icon -> + case icon of + PrimaryIcon -> entrySetText locationEntry "" + SecondaryIcon -> actionActivate load + + return () + +setupLocationView builder = do + popup <- getWidget castToMenu "ui/location-popup" + setupTreeViewPopup locationView popup + + down <- action builder "down" locationView `onRowActivated` \_ _ -> actionActivate down + binw <- action builder "browse-in-new-window" locationView `on` buttonPressEvent $ tryEvent $ do MiddleButton <- eventButton SingleClick <- eventClick @@ -102,150 +145,18 @@ Nothing -> return () - back <- getAction srvAG "back" - forward <- getAction srvAG "forward" - up <- getAction srvAG "up" - refresh <- getAction srvAG "refresh" - let updateN = do - (eb, ef, eu, er) <- canGo - actionSetSensitive back eb - actionSetSensitive forward ef - actionSetSensitive up eu - actionSetSensitive refresh er - onLocation . add . ever . const $ updateN - updateN - - updateWindowTitle - return () +setupConnection builder = do + ag <- builderGetObject builder castToActionGroup "server-actions" -uiActions browse = - [ ActionEntry - { actionEntryName = "location" - , actionEntryLabel = "_Location" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = return () - } - , ActionEntry - { actionEntryName = "new-window" - , actionEntryLabel = "_New window" - , actionEntryStockId = Just stockNew - , actionEntryAccelerator = Just "n" - , actionEntryTooltip = Nothing - , actionEntryCallback = newWindow browse - } - , ActionEntry - { actionEntryName = "open-location" - , actionEntryLabel = "_Open location" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Just "l" - , actionEntryTooltip = Nothing - , actionEntryCallback = openLocation - } - , ActionEntry - { actionEntryName = "go" - , actionEntryLabel = "_Go" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = return () - } - , ActionEntry - { actionEntryName = "location-popup" - , actionEntryLabel = "" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = return () - } - , ActionEntry - { actionEntryName = "clear" - , actionEntryLabel = "" - , actionEntryStockId = Just stockClear - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = clearLocationEntry - } - ] + onServerConnectionAdd . ever $ \conn -> do + actionGroupSetSensitive ag conn + locationEntry `set` [secondaryIconSensitive := conn] -srvActions browse = - [ ActionEntry - { actionEntryName = "load" - , actionEntryLabel = "" - , actionEntryStockId = Just stockJumpTo - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = loadCurrentLocation - } - , ActionEntry - { actionEntryName = "down" - , actionEntryLabel = "" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = loadAtCursor (loadLocation . Go) - } - , ActionEntry - { actionEntryName = "browse-in-new-window" - , actionEntryLabel = "_Browse in new window" - , actionEntryStockId = Just stockOpen - , actionEntryAccelerator = Just "Return" - , actionEntryTooltip = Nothing - , actionEntryCallback = browseInNewWindow browse - } - , ActionEntry - { actionEntryName = "add-to-playlist" - , actionEntryLabel = "_Add to playlist" - , actionEntryStockId = Just stockAdd - , actionEntryAccelerator = Just "p" - , actionEntryTooltip = Nothing - , actionEntryCallback = addToPlaylist - } - , ActionEntry - { actionEntryName = "replace-playlist" - , actionEntryLabel = "_Replace playlist" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Just "p" - , actionEntryTooltip = Nothing - , actionEntryCallback = replacePlaylist - } - , ActionEntry - { actionEntryName = "back" - , actionEntryLabel = "Go _back" - , actionEntryStockId = Just stockGoBack - , actionEntryAccelerator = Just "Left" - , actionEntryTooltip = Nothing - , actionEntryCallback = loadLocation Back - } - , ActionEntry - { actionEntryName = "forward" - , actionEntryLabel = "Go _forward" - , actionEntryStockId = Just stockGoForward - , actionEntryAccelerator = Just "Right" - , actionEntryTooltip = Nothing - , actionEntryCallback = loadLocation Forward - } - , ActionEntry - { actionEntryName = "up" - , actionEntryLabel = "Go _up" - , actionEntryStockId = Just stockGoUp - , actionEntryAccelerator = Just "Up" - , actionEntryTooltip = Nothing - , actionEntryCallback = loadLocation Up - } - , ActionEntry - { actionEntryName = "refresh" - , actionEntryLabel = "_Refresh" - , actionEntryStockId = Just stockRefresh - , actionEntryAccelerator = Just "F5" - , actionEntryTooltip = Nothing - , actionEntryCallback = loadLocation Refresh - } - ] + return () + loadCurrentLocation = do text <- trim <$> entryGetText locationEntry case text of @@ -266,10 +177,6 @@ when (iIsDir item) $ func $ iPath item _ -> return () - -clearLocationEntry = do - entrySetText locationEntry "" - widgetGrabFocus locationEntry browseInNewWindow browse = do order <- getSortOrder diff --git a/src/Location/View.hs b/src/Location/View.hs --- a/src/Location/View.hs +++ b/src/Location/View.hs @@ -45,11 +45,11 @@ locationEntry = vEntry context -initView = do - context <- initContext +initView builder = do + context <- initContext builder let ?context = context - treeViewSetRulesHint locationView True + treeViewSetModel locationView sortModel treeSelectionSetMode locationSel SelectionMultiple @@ -93,10 +93,10 @@ return ?context -initContext = do - view <- treeViewNewWithModel sortModel +initContext builder = do + view <- builderGetObject builder castToTreeView "location-view" sel <- treeViewGetSelection view - entry <- entryNew + entry <- builderGetObject builder castToEntry "location-entry" return $ augmentContext View { vView = view , vSel = sel diff --git a/src/Playlist.hs b/src/Playlist.hs --- a/src/Playlist.hs +++ b/src/Playlist.hs @@ -41,7 +41,9 @@ initFormat showPlaylist = do - context <- initUI + builder <- makeBuilder "playlist" + + context <- initUI builder let ?context = context context <- initModel @@ -50,15 +52,18 @@ context <- initIndex let ?context = context - context <- initView + context <- initView builder let ?context = context context <- initPlaylistConfig let ?context = context + context <- initUpdate + let ?context = context + setupSearch - setupUpdate setupDnD - setupUI + setupUI builder widgetShowAll window + diff --git a/src/Playlist/Model.hs b/src/Playlist/Model.hs --- a/src/Playlist/Model.hs +++ b/src/Playlist/Model.hs @@ -26,6 +26,7 @@ , getPlaylistSize , touchPlaylist , onPlaylistUpdated + , beforeDeletingTrack , playlistGetIds ) where @@ -43,13 +44,15 @@ = State { sName :: Maybe String } data Model - = Model { mStore :: ListStore Int32 - , mOnPlaylistUpdated :: HandlerMVar () - , mState :: MVar State + = Model { mStore :: ListStore Int32 + , mOnPlaylistUpdated :: HandlerMVar () + , mBeforeDeletingTrack :: HandlerMVar Int + , mState :: MVar State } playlistStore = mStore context onPlaylistUpdated = onHandler (mOnPlaylistUpdated context) +beforeDeletingTrack = onHandler (mBeforeDeletingTrack context) state = mState context getPlaylistName = withMVar state (return . sName) @@ -77,13 +80,15 @@ initContext = do - store <- listStoreNewDND [] Nothing Nothing - onPlaylistUpdated <- makeHandlerMVar - state <- newMVar makeState + store <- listStoreNewDND [] Nothing Nothing + onPlaylistUpdated <- makeHandlerMVar + beforeDeletingTrack <- makeHandlerMVar + state <- newMVar makeState return $ augmentContext - Model { mStore = store - , mOnPlaylistUpdated = onPlaylistUpdated - , mState = state + Model { mStore = store + , mOnPlaylistUpdated = onPlaylistUpdated + , mBeforeDeletingTrack = beforeDeletingTrack + , mState = state } makeState = diff --git a/src/Playlist/UI.hs b/src/Playlist/UI.hs --- a/src/Playlist/UI.hs +++ b/src/Playlist/UI.hs @@ -49,9 +49,24 @@ import Playlist.Control -setupUI = do - addUIActions uiActions +setupUI builder = do + setupActions builder + setupPlaybar builder + playlistView `onRowActivated` \[n] _ -> + playTrack n + + popup <- getWidget castToMenu "ui/playlist-popup" + setupTreeViewPopup playlistView popup + + window `onDestroy` mainQuit + + return () + + +setupActions builder = do + urlEntryDialog <- unsafeInterleaveIO $ makeURLEntryDialog + orderDialog <- unsafeInterleaveIO $ makeOrderDialog $ \v -> do let outerw = outer v updateTitle = do @@ -63,16 +78,48 @@ updateTitle windowSetDefaultSize outerw 500 400 - urlEntryDialog <- unsafeInterleaveIO $ makeURLEntryDialog + ag <- builderGetObject builder castToActionGroup "server-actions" + onServerConnectionAdd . ever $ actionGroupSetSensitive ag - srvAG <- actionGroupNew "server" - actionGroupAddActions srvAG $ srvActions orderDialog urlEntryDialog - onServerConnectionAdd . ever $ actionGroupSetSensitive srvAG - insertActionGroup srvAG 1 + bindActions builder + [ ("play", startPlayback False) + , ("pause", pausePlayback) + , ("stop", stopPlayback) + , ("prev", prevTrack) + , ("next", nextTrack) + , ("quit", mainQuit) + , ("cut", editDelete True) + , ("copy", editCopy) + , ("paste", editPaste False) + , ("append", editPaste True) + , ("delete", editDelete False) + , ("select-all", editSelectAll) + , ("invert-selection", editInvertSelection) + , ("browse-location", browseLocation SortAscending Nothing) + , ("browse-collection", browseCollection Nothing) + , ("add-media", runURLEntryDialog urlEntryDialog) + , ("clear-playlist", clearPlaylist) + , ("sort-by", showOrderDialog orderDialog getOrder setOrder) + , ("configure-playlist", showPlaylistConfigDialog) + , ("edit-properties", showPropertyEditor) + , ("export-properties", showPropertyExport) + , ("import-properties", showPropertyImport) + , ("manage-properties", showPropertyManager) + ] - play <- getAction srvAG "play" - pause <- getAction srvAG "pause" - stop <- getAction srvAG "stop" + play <- action builder "play" + pause <- action builder "pause" + stop <- action builder "stop" + prev <- action builder "prev" + next <- action builder "next" + cut <- action builder "cut" + copy <- action builder "copy" + paste <- action builder "paste" + append <- action builder "append" + delete <- action builder "delete" + editp <- action builder "edit-properties" + export <- action builder "export-properties" + let setupPPS = do ps <- getPlaybackStatus let (ePlay, ePause, eStop) = case ps of @@ -84,10 +131,7 @@ actionSetSensitive pause ePause actionSetVisible pause ePause actionSetSensitive stop eStop - - prev <- getAction srvAG "prev" - next <- getAction srvAG "next" - let setupPN = do + setupPN = do size <- getPlaylistSize name <- getPlaylistName cpos <- getCurrentTrack @@ -98,49 +142,31 @@ (False, False) actionSetSensitive prev ep actionSetSensitive next en - - cut <- getAction srvAG "cut" - copy <- getAction srvAG "copy" - delete <- getAction srvAG "delete" - editp <- getAction srvAG "edit-properties" - expp <- getAction srvAG "export-properties" - let setupSel = do + setupSel = do n <- treeSelectionCountSelectedRows playlistSel mapM_ (`actionSetSensitive` (n /= 0)) - [cut, copy, delete, editp, expp] - - paste <- getAction srvAG "paste" - append <- getAction srvAG "append" - let setupPA = do + [cut, copy, delete, editp, export] + setupPA = do en <- editCheckClipboard mapM_ (`actionSetSensitive` en) [paste, append] onPlaybackStatus . add . ever . const $ setupPPS onCurrentTrack . add . ever . const $ setupPN - onPlaylistUpdated . add . ever . const $ setupPN + onPlaylistUpdated . add . ever . const $ (setupPN >> updateWindowTitle) onClipboardTargets . add . ever . const $ setupPA playlistSel `onSelectionChanged` setupSel flip timeoutAdd 0 $ do setupPPS setupPN - setupSel setupPA + setupSel + updateWindowTitle return False - addUIFromFile "playlist" - - playlistView `onRowActivated` \[n] _ -> - playTrack n - - scroll <- scrolledWindowNew Nothing Nothing - scrolledWindowSetPolicy scroll PolicyAutomatic PolicyAutomatic - scrolledWindowSetShadowType scroll ShadowIn - containerAdd scroll playlistView - boxPackStartDefaults contents scroll + return () - playbar <- getWidget castToToolbar "ui/playbar" - toolbarSetStyle playbar ToolbarIcons - boxPackEnd contents playbar PackNatural 0 +setupPlaybar builder = do + playbar <- builderGetObject builder castToToolbar "playbar" sep <- separatorToolItemNew separatorToolItemSetDraw sep False @@ -165,241 +191,13 @@ containerAdd volumeItem volView toolbarInsert playbar volumeItem (-1) - popup <- getWidget castToMenu "ui/playlist-popup" - setupTreeViewPopup playlistView popup - - window `onDestroy` mainQuit - - -uiActions = - [ ActionEntry - { actionEntryName = "music" - , actionEntryLabel = "_Music" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = return () - } - , ActionEntry - { actionEntryName = "edit" - , actionEntryLabel = "_Edit" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = return () - } - , ActionEntry - { actionEntryName = "browse" - , actionEntryLabel = "_Browse" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = return () - } - , ActionEntry - { actionEntryName = "playlist" - , actionEntryLabel = "_Playlist" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = return () - } - , ActionEntry - { actionEntryName = "configure-playlist" - , actionEntryLabel = "C_onfigure playlist" - , actionEntryStockId = Just stockPreferences - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = showPlaylistConfigDialog - } - , ActionEntry - { actionEntryName = "properties" - , actionEntryLabel = "P_roperties" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = return () - } - , ActionEntry - { actionEntryName = "manage-properties" - , actionEntryLabel = "_Manage properties" - , actionEntryStockId = Just stockPreferences - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = showPropertyManager - } - , ActionEntry - { actionEntryName = "playlist-popup" - , actionEntryLabel = "" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = return () - } - ] + return () -srvActions orderDialog urlEntryDialog = - [ ActionEntry - { actionEntryName = "play" - , actionEntryLabel = "_Play" - , actionEntryStockId = Just stockMediaPlay - , actionEntryAccelerator = Just "Return" - , actionEntryTooltip = Nothing - , actionEntryCallback = startPlayback False - } - , ActionEntry - { actionEntryName = "pause" - , actionEntryLabel = "_Pause" - , actionEntryStockId = Just stockMediaPause - , actionEntryAccelerator = Just "Return" - , actionEntryTooltip = Nothing - , actionEntryCallback = pausePlayback - } - , ActionEntry - { actionEntryName = "stop" - , actionEntryLabel = "_Stop" - , actionEntryStockId = Just stockMediaStop - , actionEntryAccelerator = Just "s" - , actionEntryTooltip = Nothing - , actionEntryCallback = stopPlayback - } - , ActionEntry - { actionEntryName = "prev" - , actionEntryLabel = "P_revious track" - , actionEntryStockId = Just stockMediaPrevious - , actionEntryAccelerator = Just "p" - , actionEntryTooltip = Nothing - , actionEntryCallback = prevTrack - } - , ActionEntry - { actionEntryName = "next" - , actionEntryLabel = "_Next track" - , actionEntryStockId = Just stockMediaNext - , actionEntryAccelerator = Just "n" - , actionEntryTooltip = Nothing - , actionEntryCallback = nextTrack - } - , ActionEntry - { actionEntryName = "cut" - , actionEntryLabel = "Cu_t" - , actionEntryStockId = Just stockCut - , actionEntryAccelerator = Just "x" - , actionEntryTooltip = Nothing - , actionEntryCallback = editDelete True - } - , ActionEntry - { actionEntryName = "copy" - , actionEntryLabel = "_Copy" - , actionEntryStockId = Just stockCopy - , actionEntryAccelerator = Just "c" - , actionEntryTooltip = Nothing - , actionEntryCallback = editCopy - } - , ActionEntry - { actionEntryName = "paste" - , actionEntryLabel = "_Paste" - , actionEntryStockId = Just stockPaste - , actionEntryAccelerator = Just "v" - , actionEntryTooltip = Nothing - , actionEntryCallback = editPaste False - } - , ActionEntry - { actionEntryName = "append" - , actionEntryLabel = "_Append" - , actionEntryStockId = Just stockPaste - , actionEntryAccelerator = Just "v" - , actionEntryTooltip = Nothing - , actionEntryCallback = editPaste True - } - , ActionEntry - { actionEntryName = "delete" - , actionEntryLabel = "_Delete" - , actionEntryStockId = Just stockDelete - , actionEntryAccelerator = Just "Delete" - , actionEntryTooltip = Nothing - , actionEntryCallback = editDelete False - } - , ActionEntry - { actionEntryName = "select-all" - , actionEntryLabel = "_Select all" - , actionEntryStockId = Just stockSelectAll - , actionEntryAccelerator = Just "a" - , actionEntryTooltip = Nothing - , actionEntryCallback = editSelectAll - } - , ActionEntry - { actionEntryName = "invert-selection" - , actionEntryLabel = "_Invert selection" - , actionEntryStockId = Just stockSelectAll - , actionEntryAccelerator = Just "a" - , actionEntryTooltip = Nothing - , actionEntryCallback = editInvertSelection - } - , ActionEntry - { actionEntryName = "browse-location" - , actionEntryLabel = "Browse _location" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = browseLocation SortAscending Nothing - } - , ActionEntry - { actionEntryName = "browse-collection" - , actionEntryLabel = "Browse _collection" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = browseCollection Nothing - } - , ActionEntry - { actionEntryName = "add-media" - , actionEntryLabel = "_Add media" - , actionEntryStockId = Just stockAdd - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = runURLEntryDialog urlEntryDialog - } - , ActionEntry - { actionEntryName = "clear-playlist" - , actionEntryLabel = "_Clear playlist" - , actionEntryStockId = Just stockClear - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = clearPlaylist - } - , ActionEntry - { actionEntryName = "sort-by" - , actionEntryLabel = "_Sort by…" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = showOrderDialog orderDialog getOrder setOrder - } - , ActionEntry - { actionEntryName = "edit-properties" - , actionEntryLabel = "_Edit properties" - , actionEntryStockId = Just stockEdit - , actionEntryAccelerator = Just "Return" - , actionEntryTooltip = Nothing - , actionEntryCallback = showPropertyEditor - } - , ActionEntry - { actionEntryName = "export-properties" - , actionEntryLabel = "E_xport properties" - , actionEntryStockId = Just stockSave - , actionEntryAccelerator = Just "" - , actionEntryTooltip = Nothing - , actionEntryCallback = showPropertyExport - } - , ActionEntry - { actionEntryName = "import-properties" - , actionEntryLabel = "_Import properties" - , actionEntryStockId = Just stockOpen - , actionEntryAccelerator = Just "" - , actionEntryTooltip = Nothing - , actionEntryCallback = showPropertyImport - } - ] +updateWindowTitle = do + maybeName <- getPlaylistName + setWindowTitle $ case maybeName of + Nothing -> "Vision playlist" + Just name -> name ++ " - Vision playlist" data URLEntry = diff --git a/src/Playlist/Update.hs b/src/Playlist/Update.hs --- a/src/Playlist/Update.hs +++ b/src/Playlist/Update.hs @@ -18,7 +18,8 @@ -- module Playlist.Update - ( setupUpdate + ( initUpdate + , onPlaylistLoaded ) where import Control.Applicative @@ -32,13 +33,23 @@ import XMMS import Handler +import Utils +import Context import Playback import Playlist.Model import Playlist.Index -import Playlist.View -setupUpdate = do +data Context + = Context { cOnPlaylistLoaded :: HandlerMVar () } + +onPlaylistLoaded = onHandler $ cOnPlaylistLoaded context + + +initUpdate = do + context <- initContext + let ?context = context + onServerConnectionAdd . ever $ \conn -> if conn then do @@ -50,8 +61,8 @@ persist else do setPlaylistName Nothing - updateWindowTitle clearModel + onPlaylistLoaded $ invoke () onPlaybackStatus . add . ever . const $ do maybeCT <- getCurrentTrack @@ -78,12 +89,19 @@ _ -> return () + return ?context + +initContext = do + onPlaylistLoaded <- makeHandlerMVar + return $ augmentContext + Context { cOnPlaylistLoaded = onPlaylistLoaded } + setupPlaylist = do name <- result liftIO $ do setPlaylistName $ Just name - updateWindowTitle requestPlaylist name + onPlaylistLoaded $ invoke () requestPlaylist name = playlistListEntries xmms (Just name) >>* handlePlaylist @@ -107,6 +125,7 @@ when (name == playlist change) $ case change of PlaylistRemove { position = p } -> do + beforeDeletingTrack $ invoke p listStoreRemove playlistStore p onPlaylistUpdated $ invoke () PlaylistAdd { mlibId = id } -> do @@ -118,6 +137,7 @@ addToIndex id n onPlaylistUpdated $ invoke () PlaylistMove { mlibId = id, position = o, newPosition = n } -> do + beforeDeletingTrack $ invoke o listStoreRemove playlistStore o listStoreInsert playlistStore n id addToIndex id n diff --git a/src/Playlist/View.hs b/src/Playlist/View.hs --- a/src/Playlist/View.hs +++ b/src/Playlist/View.hs @@ -17,11 +17,12 @@ -- General Public License for more details. -- +{-# LANGUAGE TupleSections #-} + module Playlist.View ( initView , playlistView , playlistSel - , updateWindowTitle , getSelectedTracks ) where @@ -29,17 +30,16 @@ import Data.Maybe -import Graphics.UI.Gtk +import Graphics.UI.Gtk hiding (add) import XMMS2.Client import Context -import UI +import Handler import Playback import Playlist.Model import Playlist.Index import Playlist.Format ---import Playlist.Control data View @@ -50,10 +50,12 @@ playlistSel = vSel context -initView = do - context <- initContext +initView builder = do + context <- initContext builder let ?context = context + treeViewSetModel playlistView playlistStore + treeViewSetRulesHint playlistView True treeViewSetReorderable playlistView True treeViewSetHeadersVisible playlistView False @@ -95,6 +97,16 @@ info <- getInfoIfNeeded iter cell `set` [ cellText := trackInfoDuration info ] + beforeDeletingTrack . add . ever $ \t -> do + cursor <- treeViewGetCursor playlistView + case cursor of + ([p], c) | p == t -> do + s <- getPlaylistSize + let p' = if p + 1 < s then p + 1 else max (p - 1) 0 + c' = maybe Nothing (Just . (, False)) c + treeViewSetCursor playlistView [p'] c' + _ -> return () + return ?context @@ -107,14 +119,8 @@ _ -> False -updateWindowTitle = do - maybeName <- getPlaylistName - setWindowTitle $ case maybeName of - Nothing -> "Vision playlist" - Just name -> name ++ " - Vision playlist" - -initContext = do - view <- treeViewNewWithModel playlistStore +initContext builder = do + view <- builderGetObject builder castToTreeView "playlist-view" sel <- treeViewGetSelection view return $ augmentContext View { vView = view diff --git a/src/Playtime.hs b/src/Playtime.hs --- a/src/Playtime.hs +++ b/src/Playtime.hs @@ -107,6 +107,8 @@ handleCurrentId = do cid <- result liftIO $ do + setValue 0 + setUpper bigNum setCurrentId $ if cid == 0 then Nothing @@ -123,7 +125,6 @@ bigNum = 10000000000.0 seek pos = do - putStrLn $ "seek to " ++ show pos eid <- disableUpdate playbackSeekMs xmms (round pos) SeekSet >>* liftIO (scheduleEnableUpdate eid) diff --git a/src/Properties/View.hs b/src/Properties/View.hs --- a/src/Properties/View.hs +++ b/src/Properties/View.hs @@ -162,33 +162,48 @@ let updFilter func props = do modifyIORef selected $ func (Set.fromList $ map propName props) treeModelFilterRefilter filter - addProps = do - sel <- treeViewGetSelection left - rows <- treeSelectionGetSelectedRows sel - rows <- mapM (treeModelFilterConvertPathToChildPath filter) rows - props <- mapM (listStoreGetValue propertyStore . head) rows - mapM (listStoreAppend store . make) props + takeProps = do + sel <- treeViewGetSelection left + rows <- treeSelectionGetSelectedRows sel + rows <- mapM (liftM head . treeModelFilterConvertPathToChildPath filter) rows + props <- mapM (listStoreGetValue propertyStore) rows + cursor <- treeViewGetCursor left updFilter Set.union props + case cursor of + ([n], c) -> do + size1 <- listStoreGetSize propertyStore + size2 <- Set.size <$> readIORef selected + let up = length $ takeWhile (n >) rows + n' = min (n - up) $ max 0 (size1 - size2 - 1) + c' = maybe Nothing (Just . (, False)) c + treeViewSetCursor left [n'] c' + _ -> return () + return props + addProps = + mapM_ (listStoreAppend store . make) =<< takeProps - left `onRowActivated` \_ _ -> addProps + left `onRowActivated` \_ _ -> + addProps left `on` keyPressEvent $ tryEvent $ do [] <- eventModifier "Return" <- eventKeyName liftIO addProps - setupLeftDnD filter left + setupLeftDnD left takeProps - right `on` keyPressEvent $ tryEvent $ do - [] <- eventModifier - "Delete" <- eventKeyName - liftIO $ do - sel <- treeViewGetSelection right - rows <- treeSelectionGetSelectedRows sel - props <- mapM (listStoreGetValue store . head) rows - mapM_ (listStoreRemove store . head) $ reverse rows - updFilter (flip Set.difference) $ map fst props + right `onRowActivated` \_ _ -> + deleteSelectedRows store right updFilter + right `on` keyPressEvent $ do + m <- eventModifier + k <- eventKeyName + case (m, k) of + ([], "Delete") -> do + liftIO $ deleteSelectedRows store right updFilter + return True + (_, "Return") -> return True + _ -> return False setupRightDnD store right make updFilter @@ -201,21 +216,16 @@ , vSelected = selected } - -setupLeftDnD filter left = do +setupLeftDnD left takeProps = do targetList <- targetListNew targetListAdd targetList propertyNameListTarget [TargetSameApp] 0 dragSourceSet left [Button1] [ActionCopy] dragSourceSetTargetList left targetList - sel <- treeViewGetSelection left - left `on` dragDataGet $ \_ _ _ -> do - names <- liftIO $ do - rows <- treeSelectionGetSelectedRows sel - rows <- mapM (treeModelFilterConvertPathToChildPath filter) rows - mapM (liftM propName . listStoreGetValue propertyStore . head) rows - selectionDataSetStringList names + left `on` dragDataGet $ \_ _ _ -> + selectionDataSetStringList =<< + liftIO (map propName <$> takeProps) setupDragDest left [DestDefaultMotion, DestDefaultHighlight] @@ -259,8 +269,22 @@ return (True, False) ] - view `on` dragDataDelete $ \_ -> do - rows <- treeSelectionGetSelectedRows sel - props <- mapM (listStoreGetValue store . head) rows - mapM_ (listStoreRemove store . head) $ reverse rows - updFilter (flip Set.difference) $ map fst props + view `on` dragDataDelete $ const $ + deleteSelectedRows store view updFilter + + +deleteSelectedRows store view updFilter = do + sel <- treeViewGetSelection view + rows <- map head <$> treeSelectionGetSelectedRows sel + props <- mapM (listStoreGetValue store) rows + cursor <- treeViewGetCursor view + mapM_ (listStoreRemove store) $ reverse rows + updFilter (flip Set.difference) $ map fst props + case cursor of + ([n], c) -> do + size <- listStoreGetSize store + let up = length $ takeWhile (n >) rows + n' = min (n - up) $ max 0 (size - 1) + c' = maybe Nothing (Just . (, False)) c + treeViewSetCursor view [n'] c' + _ -> return () diff --git a/src/UI.hs b/src/UI.hs --- a/src/UI.hs +++ b/src/UI.hs @@ -30,6 +30,12 @@ , addUIActions , getAction , windowGroup + , makeUI + , makeBuilder + , action + , actions + , bindAction + , bindActions ) where import Control.Applicative @@ -57,93 +63,61 @@ uiActionGroup = uActionGroup context windowGroup = uWindowGroup context -initUI = do - context <- initContext +setWindowTitle = windowSetTitle window +addUIActions = actionGroupAddActions uiActionGroup +insertActionGroup = uiManagerInsertActionGroup uiManager +addUIFromFile = uiManagerAddUiFromFile uiManager . uiFilePath +maybeGetWidget cast name = fmap cast <$> uiManagerGetWidget uiManager name +getWidget cast name = fromJust <$> maybeGetWidget cast name +getAction group name = fromJust <$> actionGroupGetAction group name + + +initUI builder = do + context <- augmentContext <$> makeUI builder let ?context = context - windowGroupAddWindow windowGroup window - containerAdd window contents + mapM_ (uncurry $ maybeBindAction builder) + [ ("close", widgetDestroy window) + , ("quit", mainQuit) + , ("about", showAbout window) + ] - windowAddAccelGroup window =<< uiManagerGetAccelGroup uiManager - insertActionGroup uiActionGroup 1 - addUIActions uiActions - addUIFromFile "common" + return context - menubar <- getWidget castToMenuBar "ui/menubar" - boxPackStart contents menubar PackNatural 0 +makeUI builder = do + window <- builderGetObject builder castToWindow "main-window" + contents <- builderGetObject builder castToVBox "contents" + uiManager <- builderGetObject builder castToUIManager "ui-manager" + uiActionGroup <- builderGetObject builder castToActionGroup "ui-actions" + windowGroup <- windowGroupNew + return UI { uWindow = window + , uContents = contents + , uManager = uiManager + , uActionGroup = uiActionGroup + , uWindowGroup = windowGroup + } - return ?context +makeBuilder name = do + builder <- builderNew + builderAddFromFile builder $ gladeFilePath name + return builder +action builder name = + builderGetObject builder castToAction name -initContext = do - window <- windowNew - contents <- vBoxNew False 0 - uiManager <- uiManagerNew - uiActionGroup <- actionGroupNew "ui" - windowGroup <- windowGroupNew - return $ augmentContext - UI { uWindow = window - , uContents = contents - , uManager = uiManager - , uActionGroup = uiActionGroup - , uWindowGroup = windowGroup - } +actions builder = + mapM (action builder) -setWindowTitle = windowSetTitle window -addUIActions = actionGroupAddActions uiActionGroup -insertActionGroup = uiManagerInsertActionGroup uiManager -addUIFromFile = uiManagerAddUiFromFile uiManager . uiFilePath -maybeGetWidget cast name = fmap cast <$> uiManagerGetWidget uiManager name -getWidget cast name = fromJust <$> maybeGetWidget cast name -getAction group name = fromJust <$> actionGroupGetAction group name +bindAction builder name func = do + a <- action builder name + a `on` actionActivated $ func -uiActions = - [ ActionEntry - { actionEntryName = "menubar" - , actionEntryLabel = "" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = return () - } - , ActionEntry - { actionEntryName = "toolbar" - , actionEntryLabel = "" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = return () - } - , ActionEntry - { actionEntryName = "quit" - , actionEntryLabel = "_Quit" - , actionEntryStockId = Just stockQuit - , actionEntryAccelerator = Just "q" - , actionEntryTooltip = Nothing - , actionEntryCallback = mainQuit - } - , ActionEntry - { actionEntryName = "close-window" - , actionEntryLabel = "_Close window" - , actionEntryStockId = Just stockClose - , actionEntryAccelerator = Just "w" - , actionEntryTooltip = Nothing - , actionEntryCallback = widgetDestroy window - } - , ActionEntry - { actionEntryName = "help" - , actionEntryLabel = "_Help" - , actionEntryStockId = Nothing - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = return () - } - , ActionEntry - { actionEntryName = "about" - , actionEntryLabel = "_About" - , actionEntryStockId = Just stockAbout - , actionEntryAccelerator = Nothing - , actionEntryTooltip = Nothing - , actionEntryCallback = showAbout window - } - ] +bindActions builder = + mapM (uncurry $ bindAction builder) + +maybeBindAction builder name func = do + ma <- builderGetObjectRaw builder name + case ma of + Just a -> Just <$> on (castToAction a) actionActivated func + Nothing -> return Nothing + diff --git a/src/Utils.hs b/src/Utils.hs --- a/src/Utils.hs +++ b/src/Utils.hs @@ -34,6 +34,9 @@ , hideOnDeleteEvent , eqBy , tryModifyMVar_ + , EntryIcon (..) + , onIconPress + , secondaryIconSensitive ) where import Prelude hiding (catch) @@ -46,7 +49,10 @@ import Data.Char hiding (Control) import Codec.Binary.UTF8.String +import Foreign.C.Types + import Graphics.UI.Gtk +import System.Glib.Properties import XMMS2.Client @@ -174,3 +180,20 @@ deriving instance MonadCatchIO (ResultM c a) + +data EntryIcon + = PrimaryIcon + | SecondaryIcon + deriving (Enum, Eq) + +onIconPress + :: EntryClass ec + => ec + -> (EntryIcon -> IO ()) + -> IO (ConnectId ec) +onIconPress entry handler = + connectGeneric "icon-press" False entry $ \_ pos _ -> + handler $ toEnum $ fromIntegral (pos :: CInt) + +secondaryIconSensitive = + newAttrFromBoolProperty "secondary-icon-sensitive" diff --git a/src/XMMS.hs b/src/XMMS.hs --- a/src/XMMS.hs +++ b/src/XMMS.hs @@ -79,23 +79,19 @@ scheduleTryConnect = timeoutAdd tryConnect tryConnect = do - putStr "connecting... " success <- connect xmms xmmsPath if success then do - putStrLn "connected!" disconnectCallbackSet xmms disconnectCallback mainLoopGMainInit xmms modifyMVar_ state $ \s -> return s { sConnected = True } onServerConnection $ invoke True return False else do - putStrLn "failed." scheduleTryConnect 1000 return False disconnectCallback = do - putStrLn "disconnected." modifyMVar_ state $ \s -> return s { sConnected = False } onServerConnection $ invoke False scheduleTryConnect 1000 diff --git a/ui/collection-browser.glade b/ui/collection-browser.glade new file mode 100644 --- /dev/null +++ b/ui/collection-browser.glade @@ -0,0 +1,352 @@ + + + + + + + + + + _Collection + + + + + _New window + gtk-new + + + + + + _Edit filter + gtk-edit + + + + + + A_ll media + gtk-new + + + + + + _Close window + gtk-close + + + + + _Quit + gtk-quit + + + + + _Edit + + + + + _View + + + + + Configure _columns + + + + + Configure _ordering + + + + + P_roperties + + + + + _Manage properties… + gtk-preferences + + + + + _Help + + + + + _About + gtk-about + + + + + + + + + _Browse in new window + gtk-open + + + + + + _Save collection… + gtk-save + + + + + + Rena_me collection… + + + + + _Delete collection + gtk-delete + + + + + _Add to playlist + gtk-add + + + + + + _Replace playlist + + + + + + _Add to playlist + gtk-add + + + + + _Replace playlist + + + + + _Add to playlist + gtk-add + + + + + _Replace playlist + + + + + _Copy + gtk-copy + + + + + + _Select all + gtk-select-all + + + + + + _Invert selection + gtk-select-all + + + + + + _Edit properties + gtk-edit + + + + + + E_xport properties… + gtk-save + + + + + + _Import properties… + gtk-open + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + True + + + True + + + False + 0 + + + + + True + True + + + True + True + automatic + automatic + in + + + True + True + False + False + + + + + False + True + + + + + True + 5 + + + True + True + ● + gtk-clear + True + Clear filter + gtk-jump-to + True + Apply filter to selected collection + + + False + 0 + + + + + True + True + automatic + automatic + in + + + True + True + False + True + + + + + 1 + + + + + True + False + + + + + 1 + + + + + + diff --git a/ui/collection-browser.xml b/ui/collection-browser.xml deleted file mode 100644 --- a/ui/collection-browser.xml +++ /dev/null @@ -1,59 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/ui/location-browser.glade b/ui/location-browser.glade new file mode 100644 --- /dev/null +++ b/ui/location-browser.glade @@ -0,0 +1,210 @@ + + + + + + + + + + _Location + + + + + _New window + gtk-new + + + + + + _Open location + + + + + + _Close window + gtk-close + + + + + _Quit + gtk-quit + + + + + _Go + + + + + _Help + + + + + _About + gtk-about + + + + + + + + + + + + + + + _Browse in new window + gtk-open + + + + + + _Add to playlist + gtk-add + + + + + + _Replace playlist + + + + + + Go _back + gtk-go-back + + + + + + Go _forward + gtk-go-forward + + + + + + Go _up + gtk-go-up + + + + + + _Refresh + gtk-refresh + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + True + + + True + + + False + 0 + + + + + True + icons + + + False + 1 + + + + + True + True + automatic + automatic + in + + + True + True + True + + + + + 2 + + + + + + + True + True + ● + gtk-clear + True + Clear location + gtk-jump-to + True + Open location + + diff --git a/ui/location-browser.xml b/ui/location-browser.xml deleted file mode 100644 --- a/ui/location-browser.xml +++ /dev/null @@ -1,39 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/ui/playlist.glade b/ui/playlist.glade new file mode 100644 --- /dev/null +++ b/ui/playlist.glade @@ -0,0 +1,314 @@ + + + + + + + + + + _Music + + + + + _Quit + gtk-quit + + + + + _Edit + + + + + _Browse + + + + + Browse _location + + + + + Browse _collection + + + + + _Playlist + + + + + C_onfigure playlist… + gtk-preferences + + + + + P_roperties + + + + + _Manage properties… + gtk-preferences + + + + + _Help + + + + + _About + gtk-about + + + + + + + + + _Play + gtk-media-play + + + + + + _Pause + gtk-media-pause + + + + + + _Stop + gtk-media-stop + + + + + + P_revious track + gtk-media-previous + + + + + + _Next track + gtk-media-next + + + + + + Cu_t + gtk-cut + + + + + + _Copy + gtk-copy + + + + + + _Paste + gtk-paste + + + + + + _Append + gtk-paste + + + + + + _Delete + gtk-delete + + + + + + _Select all + gtk-select-all + + + + + + _Invert selection + gtk-select-all + + + + + + _Add media… + gtk-add + + + + + _Clear playlist + gtk-clear + + + + + _Sort by… + + + + + _Edit properties + gtk-edit + + + + + + E_xport properties… + gtk-save + + + + + + _Import properties… + gtk-open + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + True + vertical + + + True + + + False + 0 + + + + + True + True + automatic + automatic + in + + + True + True + False + True + True + + + + + 1 + + + + + True + icons + + + False + 2 + + + + + + diff --git a/ui/playlist.xml b/ui/playlist.xml deleted file mode 100644 --- a/ui/playlist.xml +++ /dev/null @@ -1,62 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/vision.cabal b/vision.cabal --- a/vision.cabal +++ b/vision.cabal @@ -1,5 +1,5 @@ name: vision -version: 0.0.3.0 +version: 0.0.4.0 author: Oleg Belozeorov maintainer: Oleg Belozeorov @@ -30,7 +30,8 @@ src/Collection/List/Makefile.in, Makefile.in, ui/Makefile.in -data-files: ui/*.xml +data-files: ui/*.xml, + ui/*.glade executable vision main-is: Vision.hs @@ -117,4 +118,4 @@ source-repository this type: git location: git://github.com/upwawet/vision.git - tag: v0.0.3.0 + tag: v0.0.4.0