packages feed

vision-0.0.2.2: src/Location/View.hs

-- -*-haskell-*-
--  Vision (for the Voice): an XMMS2 client.
--
--  Author:  Oleg Belozeorov
--  Created: 28 Jun. 2010
--
--  Copyright (C) 2010 Oleg Belozeorov
--
--  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 (at your option) 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.
--

module Location.View
  ( initView
  , locationView
  , locationSel
  , locationEntry
  ) where

import Data.List
import Data.Char

import Graphics.UI.Gtk

import Context
import Location.Model
import Location.History


data View
  = View { vView  :: TreeView
         , vSel   :: TreeSelection
         , vEntry :: Entry
         }

locationView  = vView context
locationSel   = vSel context
locationEntry = vEntry context


initView = do
  context <- initContext
  let ?context = context

  treeViewSetRulesHint locationView True

  treeSelectionSetMode locationSel SelectionMultiple

  column <- treeViewColumnNew
  treeViewAppendColumn locationView column
  treeViewColumnSetTitle column "Name"
  treeViewColumnSetSortOrder column =<< getSortOrder
  treeViewColumnSetSortIndicator column True
  treeViewColumnSetClickable column True
  column `onColClicked` do
    order <- treeViewColumnGetSortOrder column
    let order' = case order of
          SortAscending  -> SortDescending
          SortDescending -> SortAscending
    treeViewColumnSetSortOrder column order'
    setSortOrder order'

  cell <- cellRendererPixbufNew
  treeViewColumnPackStart column cell False
  cellLayoutSetAttributeFunc column cell sortModel $ \iter -> do
    item <- itemByIter iter
    cell `set` [ cellPixbufStockId :=
                 if iIsDir item
                 then stockDirectory
                 else stockFile ]

  cell <- cellRendererTextNew
  treeViewColumnPackStart column cell True
  cellLayoutSetAttributeFunc column cell sortModel $ \iter -> do
    item <- itemByIter iter
    cell `set` [ cellText := iName item ]

  treeViewSetEnableSearch locationView True
  treeViewSetSearchEqualFunc locationView $ Just $ \str iter -> do
    item <- itemByIter iter
    return $ isInfixOf (map toLower str) (map toLower $ iName item)

  comp <- makeHistoryCompletion
  entrySetCompletion locationEntry comp

  return ?context


initContext = do
  view  <- treeViewNewWithModel sortModel
  sel   <- treeViewGetSelection view
  entry <- entryNew
  return $ augmentContext
    View { vView  = view
         , vSel   = sel
         , vEntry = entry
         }