Permalink
Browse files

Added quick find bar.

  • Loading branch information...
1 parent 899b0fd commit d165cdd648ef2293b7d8361e2f440ba72bd9f9f6 @sciolizer committed Dec 23, 2011
View
@@ -148,3 +148,5 @@ should be a keyboard shortcut for "include this function in the export list"
Why did I develop the habit of using explicit imports? I think it was to decrease
the frequency of recompilation... and if that's the case, then I might as well be doing it
for the internal imports as well as the other package imports.
+
+Ctrl+w doesn't work when a cursor is at the END of an identifier
@@ -22,7 +22,6 @@ import Control.Monad (foldM)
import Data.List (find, isSuffixOf, tails)
import Data.Maybe (fromMaybe)
import Graphics.UI.Gtk (Notebook(), notebookSetCurrentPage, notebookRemovePage, on, switchPage)
-import Graphics.UI.Gtk.SourceView (SourceView())
import System.FilePath (joinPath, splitPath)
import IDE.Undefineditor.Gui.Controller.MRVar
@@ -35,7 +34,7 @@ import IDE.Undefineditor.Gui.View.Notebook
-- todo: figure out how to get rid of this file. It's turning into a big ball of mud. I think I created this file back before the 'cleanly' function existed... with the existence of the 'cleanly' function, I might be able to go back to a controller-free management of the tabs. But be careful. There's definitely a lot of complexity here.
-- | Collection of tabs in a window.
-data Tabs = Tabs OpenFiles Notebook (MRVar (FM.FocusedMap FilePath (FileId, SourceView))) (forall a. IO a -> IO a)
+data Tabs = Tabs OpenFiles Notebook (MRVar (FM.FocusedMap FilePath (FileId, HaskellTab))) (forall a. IO a -> IO a)
data FocusSync = Paused | Going
@@ -79,7 +78,7 @@ openTabFile (Tabs o n mvar paused) fp = modifyMRVar_ mvar $ \fm ->
rec
let fm' = FM.insert fp (fid, editorTab) fm
let Just i = FM.locateIndex fp fm'
- editorTab <- paused $ newTab n i tb tabname
+ editorTab <- paused $ newHaskellTab n i tb (getMRVars mvar) tabname
return ()
-- sync point
paused $ do
@@ -89,7 +88,7 @@ openTabFile (Tabs o n mvar paused) fp = modifyMRVar_ mvar $ \fm ->
paused fs = bracket_ (modifyMVar_ fs (\_ -> return Paused)) (modifyMVar_ fs (\_ -> return Going))
-- | Returns the current tab and associated file, or Nothing if the tab collection is empty.
-getCurrentTab :: Tabs -> IO (Maybe (FileId, SourceView))
+getCurrentTab :: Tabs -> IO (Maybe (FileId, HaskellTab))
getCurrentTab (Tabs _ _ mvar _) = do
fm <- atomically . peekStream . readMRVar $ mvar
case FM.lookupFocus fm of
@@ -23,7 +23,9 @@ data Activation =
| ACut -- ^ Cut text from currently active buffer.
| ACopy -- ^ Copy text from currently active buffer.
| APaste -- ^ Paste text into the currently active buffer.
- | AFind -- ^ Find a substring in the currently active buffer.
+ | AFind -- ^ Displays the find bar.
+ | AFindNext -- ^ Selects the next occurence of the query in the find bar.
+ | AFindPrevious -- ^ Selects the previous occurence of the query in the find bar.
| AHoogle -- ^ Launch hoogle.
| ARearrangeImports -- ^ Re-arrange imports in the currently active buffer.
| ATabNext -- ^ Switch to the next tab.
@@ -35,4 +37,5 @@ data Activation =
| AFindUsages -- ^ Create a new window with all usages of the identifier under the cursor.
| ASelectCurrentIdentifier -- ^ Highlight the current identifier.
| AFindOccurences -- ^ Find all occurences of the identifier under the cursor. This is a temporary action, until I get 'AGoToDefinition' working properly.
+ | AEscape -- ^ Triggered when the user presses escape. Hides the find bar, and possibly other things.
deriving (Bounded, Enum, Eq, Ord, Read, Show)
@@ -1,5 +1,7 @@
{-# LANGUAGE
- NoMonomorphismRestriction
+ FlexibleInstances,
+ NoMonomorphismRestriction,
+ TypeSynonymInstances
#-}
-- | Manages keybindings.
@@ -12,12 +14,14 @@ module IDE.Undefineditor.Gui.Model.Keybindings (
showKeybinding
) where
+import Control.Monad (when)
import Control.Monad.Trans.Writer (Writer(), execWriter, tell)
import Data.Function (on)
import Data.List (intercalate)
import qualified Data.Map as M (Map(), empty, insertWithKey', lookup)
-import qualified Data.Set as S (Set(), singleton, toAscList)
-import Graphics.UI.Gtk (KeyVal(), Modifier(Control), keyFromName, keyName)
+import Data.Maybe (isNothing)
+import qualified Data.Set as S (Set(), empty, insert, singleton, toAscList)
+import Graphics.UI.Gtk (KeyVal(), Modifier(Control, Shift), keyFromName, keyName)
import IDE.Undefineditor.Gui.Controller.Reactive
import IDE.Undefineditor.Gui.Model.Activations
@@ -34,7 +38,12 @@ newKeybindings = return Keybindings
-- | Looks up the activation associated with a keyboard shortcut.
getActivation :: Keybindings -> Shortcut -> IO (Maybe Activation)
-getActivation _kb shortcut = return $ M.lookup shortcut (snd keyBindings)
+getActivation _kb shortcut = do
+ let ret = M.lookup shortcut (snd keyBindings)
+ when (isNothing ret) $ do
+ -- putStrLn $ "unrecognized keybinding: " ++ showKeybinding shortcut
+ return ()
+ return ret
-- | Looks up the shortcut associated with an activation.
getKeybinding :: Keybindings -> Activation -> Stream (Maybe Shortcut)
@@ -46,13 +55,19 @@ type Shortcut = (S.Set Modifier, KeyVal)
keyBindings :: (M.Map Activation Shortcut, M.Map Shortcut Activation)
keyBindings = canonicalize $ do
AFind =: (Control & "f")
+ AEscape =: unmodified "Escape"
+ AFindNext =: (Control & "g")
+ AFindPrevious =: (Control & Shift & "G") -- interesting how I have to use capital g
ANew =: Control & "n"
ASaveAll =: Control & "s"
ASelectCurrentIdentifier =: Control & "w"
AFindOccurences =: Control & "b"
-infixl 6 &
-x & y = (S.singleton x, keyFromName y)
+infixr 6 &
+class MakesShortcut a where (&) :: Modifier -> a -> Shortcut
+instance MakesShortcut String where x & y = (S.singleton x, keyFromName y)
+instance MakesShortcut Shortcut where mod & (mods, k) = (S.insert mod mods, k) where
+unmodified name = (S.empty, keyFromName name)
infixl 5 =:
(=:) :: Activation -> Shortcut -> Writer [(Activation, Shortcut)] ()
@@ -0,0 +1,196 @@
+-- | Functions for working with the quick-find bar.
+--
+-- There is one find bar per tab.
+module IDE.Undefineditor.Gui.View.FindBar (
+ -- * Instantiation
+ FindBar(),
+ newFindBar,
+
+ -- * Getters
+ findBarQuery,
+ findBarWidget,
+
+ -- * Actions
+ focusFindBar,
+ hideFindBar,
+ findNext,
+ findPrevious
+) where
+
+import Control.Concurrent.STM (atomically)
+import Control.Monad (liftM, unless, void)
+import Data.Maybe (fromMaybe)
+import Graphics.UI.Gtk (
+ AttrOp((:=)),
+ Entry(),
+ Packing(PackGrow),
+ TextBuffer(),
+ TextBufferClass(),
+ TextIter(),
+ TextMark(),
+ TextTag(),
+ TextView(),
+ Widget(),
+ boxPackStart,
+ editableChanged,
+ entryGetText,
+ entryNew,
+ hBoxNew,
+ on,
+ set,
+ textBufferApplyTag,
+ textBufferGetEndIter,
+ textBufferGetInsert,
+ textBufferGetIterAtMark,
+ textBufferGetSelectionBound,
+ textBufferGetStartIter,
+ textBufferGetTagTable,
+ textBufferMoveMark,
+ textBufferRemoveTag,
+ textIterBackwardSearch,
+ textIterCompare,
+ textIterForwardSearch,
+ textTagBackground,
+ textTagNew,
+ textTagTableAdd,
+ textViewGetBuffer,
+ textViewScrollToIter,
+ toWidget,
+ widgetGrabFocus,
+ widgetHide,
+ widgetShow
+ )
+
+import IDE.Undefineditor.Gui.Controller.Reactive
+
+-- | A quick-find bar bound to some text view.
+data FindBar = FindBar {
+ queryVar :: RVar String,
+ -- | The widget representing the entire bar. Usually you will want to pack the bar into a 'VBox'.
+ findBarWidget :: Widget,
+ entryBox :: Entry,
+ findBarTextView :: TextView,
+ highlightTag :: TextTag
+ }
+
+-- | Creates a new FindBar, and binds its actions to the given text view.
+--
+-- You can access the created widget using 'findBarWidget'.
+newFindBar :: RVars -> TextView -> IO FindBar
+newFindBar rvars tv = do
+ findBox <- hBoxNew False 0 -- the hbox is kind of unnecessary for now, but that will change
+ entry <- entryNew
+ widgetShow entry
+ rvar <- newRVarIO rvars ""
+ boxPackStart findBox entry PackGrow 0
+ on entry editableChanged $ cleanlyWriteRVar rvar =<< entryGetText entry
+ tb <- textViewGetBuffer tv
+ tag <- newHighlightTag tb
+ let ret = FindBar rvar (toWidget findBox) entry tv tag
+ react (Just `fmap` findBarQuery ret) $ \old new -> unless (old == new) $ highlightAll ret new
+ return ret
+
+highlightAll fb new = do
+ let tv = findBarTextView fb
+ tb <- textViewGetBuffer tv
+ let tag = highlightTag fb
+ start <- textBufferGetStartIter tb
+ end <- textBufferGetEndIter tb
+ insert <- textBufferGetIterAtMark tb =<< textBufferGetInsert tb
+ textBufferRemoveTag tb tag start end -- removes all highlighting tags
+ unless (null new) $ do
+ iters <- (`unfoldM` start) $ \st -> do
+ mbIters <- searchForwardFrom st new
+ case mbIters of
+ Nothing -> return Nothing
+ Just (left, right) -> do
+ textBufferApplyTag tb tag left right
+ return (Just (left, right))
+ unless (null iters) $ do
+ next <- findM (\i -> (/= LT) `fmap` textIterCompare insert i) iters
+ scrollTo tv (fromMaybe (last iters) next)
+
+scrollTo tv i = void $ textViewScrollToIter tv i 0.0 (Just (0.5, 0.5))
+
+unfoldM :: (Monad m) => (b -> m (Maybe (a,b))) -> b -> m [a]
+unfoldM gen seed = do
+ mbNext <- gen seed
+ case mbNext of
+ Nothing -> return []
+ Just (v, nseed) -> (v:) `liftM` unfoldM gen nseed
+
+findM :: (Monad m) => (a -> m Bool) -> [a] -> m (Maybe a)
+findM _ [] = return Nothing
+findM pred (x:xs) = do
+ b <- pred x
+ if b then return (Just x) else findM pred xs
+
+-- | Shows the find bar if it is not already shown, and transfers focus to the entry box.
+--
+-- If a query already exists in the find bar, then highlights the occurences in the text buffer.
+focusFindBar :: FindBar -> IO ()
+focusFindBar fb = do
+ let entry = entryBox fb
+ widgetShow (findBarWidget fb)
+ widgetGrabFocus entry
+ highlightAll fb =<< entryGetText entry
+
+-- | Hides the find bar from view.
+--
+-- Any highlighted text is hidden, the view is scrolled back to the cursor, and focus is returned
+-- to the text view.
+hideFindBar :: FindBar -> IO ()
+hideFindBar fb = do
+ widgetHide (findBarWidget fb)
+ let tv = findBarTextView fb
+ tb <- textViewGetBuffer tv
+ start <- textBufferGetStartIter tb
+ end <- textBufferGetEndIter tb
+ textBufferRemoveTag tb (highlightTag fb) start end -- removes all highlighting tags
+ insert <- textBufferGetIterAtMark tb =<< textBufferGetInsert tb
+ textViewScrollToIter tv insert 0.0 (Just (0.5, 0.5))
+ widgetGrabFocus tv
+
+findDirection directionFind which fb = do
+ let tv = findBarTextView fb
+ tb <- textViewGetBuffer tv
+ (selectionBoundMark, selectionBound) <- markAndIter tb textBufferGetSelectionBound
+ (insertMark, insert) <- markAndIter tb textBufferGetInsert
+ query <- atomically $ peekStream (findBarQuery fb)
+ mbIters <- directionFind (which (insert, selectionBound)) query -- todo: wrap search around
+ case mbIters of
+ Nothing -> return ()
+ Just (l,r) -> do
+ textBufferMoveMark tb insertMark l
+ textBufferMoveMark tb selectionBoundMark r
+ scrollTo tv l
+ widgetGrabFocus tv
+
+markAndIter :: (TextBufferClass tb) => tb -> (tb -> IO TextMark) -> IO (TextMark, TextIter)
+markAndIter tb getMark = do
+ mark <- getMark tb
+ iter <- textBufferGetIterAtMark tb mark
+ return (mark, iter)
+
+searchForwardFrom start query = textIterForwardSearch start query [] Nothing
+searchBackwardFrom start query = textIterBackwardSearch start query [] Nothing
+
+-- | Moves the insert mark forward until a match is found. The match is selected.
+findNext :: FindBar -> IO ()
+findNext = findDirection searchForwardFrom snd
+
+-- | Moves the insert mark backward until a match is found. The match is selected.
+findPrevious :: FindBar -> IO ()
+findPrevious = findDirection searchBackwardFrom fst
+
+-- | The value inside the entry box in the quick-find bar.
+findBarQuery :: FindBar -> Stream String
+findBarQuery = readRVar . queryVar
+
+newHighlightTag :: TextBuffer -> IO TextTag
+newHighlightTag tb = do
+ table <- textBufferGetTagTable tb
+ tag <- textTagNew Nothing
+ set tag [textTagBackground := "yellow"]
+ textTagTableAdd table tag
+ return tag
@@ -48,6 +48,8 @@ menuTemplate = do
stock "gtk-copy" ACopy
stock "gtk-paste" APaste
stock "gtk-find" AFind
+ child "Find _Next" AFindNext
+ child "Find _Previous" AFindPrevious
parent "_Run" (return ())
parent "_Tools" $ do
child "_Hoogle" AHoogle
Oops, something went wrong.

0 comments on commit d165cdd

Please sign in to comment.