diff --git a/data/Current.session b/data/Current.session --- a/data/Current.session +++ b/data/Current.session @@ -1,9 +1,15 @@ -Layout: VerticalP (TerminalP (Just LeftP) (-1)) (HorizontalP (TerminalP (Just BottomP) 0) (TerminalP (Just BottomP) 1) 376) 737 -Population: [(Just (LogSt LogState),[RightP,BottomP]),(Just (ModulesSt (ModulesState 335 (System,True) (Nothing,Nothing) (ExpanderState {localExp = ([],[]), localExpNoBlack = ([],[]), packageExp = ([],[]), packageExpNoBlack = ([],[]), systemExp = ([],[]), systemExpNoBlack = ([],[])}))),[RightP,TopP]),(Just (SearchSt (SearchState {searchString = "", searchScope = System, searchMode = Prefix {caseSense = False}})),[RightP,TopP])] -Window size: (1024,780) +Time of storage: + "Mon Mar 9 22:58:23 CET 2009" +Layout: VerticalP (TerminalP (Just TopP) (-1)) (HorizontalP (TerminalP (Just BottomP) 0) (TerminalP (Just BottomP) 0) 527) 762 +Population: [(Just (LogSt LogState),[RightP,BottomP]),(Just (ModulesSt (ModulesState 347 (System,True) (Nothing,Nothing) (ExpanderState {localExp = ([],[]), localExpNoBlack = ([],[]), packageExp = ([],[]), packageExpNoBlack = ([],[]), systemExp = ([],[]), systemExpNoBlack = ([],[])}))),[RightP,TopP])] +Window size: (1393,903) Active package: Nothing Active pane: Nothing Toolbar visible: True -FindbarState: (True,FindState {entryStr = "", entryHist = [], replaceStr = "", replaceHist = [], caseSensitive = False, entireWord = False, wrapAround = True, backward = False, lineNr = 1}) +FindbarState: (False,FindState {entryStr = "", entryHist = [], replaceStr = "", replaceHist = [], caseSensitive = False, entireWord = False, wrapAround = True, backward = False, lineNr = 1}) +Recently opened files: + [] +Recently opened packages: + [] diff --git a/data/Default.candy b/data/Default.candy --- a/data/Default.candy +++ b/data/Default.candy @@ -24,9 +24,14 @@ "forall" 0x2200 --FOR ALL "exist" 0x2203 --THERE EXISTS "not" 0x00ac --NOT SIGN -"alpha" 0x03b1 -"beta" 0x03b2 -"gamma" 0x03b3 -"delta" 0x03b4 -"epsilon" 0x03b5 + +"alpha" 0x03b1 --ALPHA +"beta" 0x03b2 --BETA +"gamma" 0x03b3 --GAMMA +"delta" 0x03b4 --DELTA +"epsilon" 0x03b5 --EPSILON +"zeta" 0x03b6 --ZETA +"eta" 0x03b7 --ETA +"theta" 0x03b8 --THETA + diff --git a/data/welcome.txt b/data/welcome.txt new file mode 100644 --- /dev/null +++ b/data/welcome.txt @@ -0,0 +1,23 @@ + + # # ###### # #### #### # # ###### ##### #### + # # # # # # # # ## ## # # # # + # # ##### # # # # # ## # ##### # # # + # ## # # # # # # # # # # # # + ## ## # # # # # # # # # # # # + # # ###### ###### #### #### # # ###### # #### + + + # ###### # # #### ## # # + # # # # # # # # # + # ##### #### #### # # ###### + # # # # # ###### # # + # # # # # # # # # # + ###### ###### # # #### # # # # + + + + "The miracle comes quietly into the mind that stops an instant and is still" + + + For further info please consult: leksah.org + diff --git a/leksah.cabal b/leksah.cabal --- a/leksah.cabal +++ b/leksah.cabal @@ -1,40 +1,41 @@ name: leksah -version: 0.4.2.1 +version: 0.4.3 cabal-version: >=1.4 -build-type: Custom +build-type: Simple license: GPL license-file: LICENSE copyright: 2007-2009 Jürgen Nicklisch-Franken -maintainer: Jutaro -build-depends: regex-posix ==0.72.0.3, utf8-string >=0.3.1.1, - bytestring >=0.9.0.1, binary >=0.4.4, ghc >=6.10.1, glib >=0.10, - gtk >=0.10, directory >=1.0.0.2, pretty >=1.0.1.0, - containers >=0.2.0.0, process >=1.0.1.0, mtl >=1.1.0.2, - parsec >=2.1.0.1, Cabal ==1.6.0.1, filepath >=1.1.0.1, - base >=4.0.0.0, old-time >=1.0.0.1, gtksourceview2 >=0.10.0 +maintainer: maintainer@leksah.org +build-depends: Cabal ==1.6.0.1, base >=4.0.0.0, binary >=0.4.4, + bytestring >=0.9.0.1, containers >=0.2.0.0, directory >=1.0.0.2, + filepath >=1.1.0.1, ghc >=6.10.1, glib >=0.10, gtk >=0.10, + gtksourceview2 >=0.10.0, mtl >=1.1.0.2, old-time >=1.0.0.1, + parsec >=2.1.0.1, pretty >=1.0.1.0, process >=1.0.1.0, + regex-posix ==0.72.0.3, utf8-string >=0.3.1.1 stability: provisional homepage: http://www.leksah.org package-url: http://code.haskell.org/leksah -bug-reports: +bug-reports: http://code.google.com/p/leksah/issues/list synopsis: Haskell IDE written in Haskell description: An Integrated Development Environment for Haskell written in Haskell. category: Development, IDE, Editor author: Jutaro tested-with: GHC ==6.10.1 -data-files: data/Current.session data/Default.candy - data/Default.keymap data/Default.prefs data/Emacs.keymap - data/Default.menu data/ide_class.png data/ide_configure.png - data/ide_data.png data/ide_error_next.png data/ide_error_prev.png - data/ide_field.png data/ide_function.png data/ide_instance.png +data-files: LICENSE Readme data/Current.session data/Default.candy + data/Default.keymap data/Default.menu data/Default.prefs + data/Emacs.keymap data/LICENSE data/Module.template + data/ide_class.png data/ide_configure.png data/ide_data.png + data/ide_error_next.png data/ide_error_prev.png data/ide_field.png + data/ide_function.png data/ide_instance.png data/ide_konstructor.png data/ide_make.png data/ide_method.png - data/ide_newtype.png data/ide_reexported.png data/ide_other.png + data/ide_newtype.png data/ide_other.png data/ide_reexported.png data/ide_rule.png data/ide_run.png data/ide_slot.png - data/ide_source.png data/ide_type.png data/leksah.png Readme - LICENSE data/LICENSE data/Module.template + data/ide_source.png data/ide_type.png data/leksah.png + data/welcome.txt data-dir: "" extra-source-files: Setup.lhs extra-tmp-files: - + executable: leksah main-is: Main.hs buildable: True @@ -52,23 +53,22 @@ install-includes: include-dirs: hs-source-dirs: src -other-modules: DeepSeq MyMissing Default Control.Event - Graphics.UI.Editor.Basics Graphics.UI.Editor.Composite - Graphics.UI.Editor.Simple Graphics.UI.Editor.Parameters - Graphics.UI.Editor.MakeEditor Graphics.UI.Frame.Panes - Graphics.UI.Frame.ViewFrame Data.Binary.Shared IDE.PrinterParser - IDE.Completion IDE.Exception IDE.ImportTool IDE.SaveSession - IDE.Menu IDE.SpecialEditors IDE.GUIHistory IDE.Leksah IDE.Keymap - IDE.SourceCandy IDE.Package IDE.FileUtils IDE.DescriptionPP - IDE.Find IDE.NotebookFlipper IDE.Metainfo.SourceCollector - IDE.Metainfo.Provider IDE.Metainfo.Serializable - IDE.Metainfo.InterfaceCollector IDE.Metainfo.GHCUtils - IDE.Core.Types IDE.Core.State IDE.Pane.Modules IDE.Pane.References - IDE.Pane.PackageFlags IDE.Pane.PackageEditor IDE.Pane.Search - IDE.Pane.Info IDE.Pane.ClassHierarchy IDE.Pane.SourceBuffer - IDE.Pane.Preferences IDE.Pane.Log -ghc-prof-options: -prof -auto-all -ghc-shared-options: -prof -auto-all +other-modules: Default DeepSeq MyMissing Data.Binary.Shared + Control.Event Graphics.UI.Frame.ViewFrame Graphics.UI.Frame.Panes + Graphics.UI.Editor.Composite Graphics.UI.Editor.Simple + Graphics.UI.Editor.Basics Graphics.UI.Editor.Parameters + Graphics.UI.Editor.MakeEditor IDE.Completion IDE.ImportTool + IDE.Find IDE.SaveSession IDE.Menu IDE.Keymap IDE.FileUtils + IDE.DescriptionPP IDE.PrinterParser IDE.Package IDE.Exception + IDE.Leksah IDE.GUIHistory IDE.SourceCandy IDE.NotebookFlipper + IDE.Core.Types IDE.Core.State IDE.Metainfo.GHCUtils + IDE.Metainfo.Provider IDE.Metainfo.SourceCollector + IDE.Metainfo.Serializable IDE.Metainfo.InterfaceCollector + IDE.Pane.Preferences IDE.Pane.ClassHierarchy IDE.Pane.PackageEditor + IDE.Pane.Info IDE.Pane.Log IDE.Pane.SourceBuffer IDE.Pane.Modules + IDE.Pane.Search IDE.Pane.References IDE.Pane.PackageFlags +ghc-prof-options: -auto-all -prof +ghc-shared-options: -auto-all -prof ghc-options: -fwarn-unused-imports -fwarn-missing-fields -fwarn-incomplete-patterns hugs-options: nhc98-options: diff --git a/src/Default.hs b/src/Default.hs --- a/src/Default.hs +++ b/src/Default.hs @@ -32,6 +32,9 @@ instance (Default alpha, Default beta) => Default (alpha, beta) where getDefault = (getDefault,getDefault) +instance (Default alpha, Default beta, Default gamma) => Default (alpha, beta, gamma) where + getDefault = (getDefault,getDefault,getDefault) + instance Default [alpha] where getDefault = [] diff --git a/src/Graphics/UI/Editor/Composite.hs b/src/Graphics/UI/Editor/Composite.hs --- a/src/Graphics/UI/Editor/Composite.hs +++ b/src/Graphics/UI/Editor/Composite.hs @@ -15,10 +15,23 @@ module Graphics.UI.Editor.Composite ( maybeEditor , pairEditor +, tupel3Editor +--, tupel4Editor +--, tupel5Editor +--, tupel6Editor +--, tupel7Editor , splitEditor , eitherOrEditor , multisetEditor , ColumnDescr(..) + +, filesEditor +, stringsEditor + +, versionEditor +, versionRangeEditor +, dependencyEditor +, dependenciesEditor ) where import Graphics.UI.Gtk @@ -33,6 +46,20 @@ import Graphics.UI.Editor.Basics import Graphics.UI.Editor.MakeEditor import Graphics.UI.Editor.Simple +import Data.List (sortBy, nub, sort, elemIndex) +import Distribution.Simple + (orEarlierVersion, + orLaterVersion, + VersionRange(..), + PackageName(..), + Dependency(..), + PackageIdentifier(..)) +import Distribution.Text (simpleParse, display) +import Distribution.Package (pkgName) +import Distribution.Version + (VersionRange(..)) +import Data.Version (Version(..)) +import MyMissing (forceJust) -- -- | An editor which composes two subeditors @@ -78,6 +105,124 @@ parameters notifier +tupel3Editor :: (Editor alpha, Parameters) + -> (Editor beta, Parameters) + -> (Editor gamma, Parameters) + -> Editor (alpha,beta,gamma) +tupel3Editor p1 p2 p3 parameters notifier = do + coreRef <- newIORef Nothing + noti1 <- emptyNotifier + noti2 <- emptyNotifier + noti3 <- emptyNotifier + mapM_ (propagateEvent notifier [noti2]) allGUIEvents + r1@(frame1,inj1,ext1) <- (fst p1) (snd p1) noti1 + r2@(frame2,inj2,ext2) <- (fst p2) (snd p2) noti2 + r3@(frame3,inj3,ext3) <- (fst p3) (snd p3) noti3 + mkEditor + (\widget (v1,v2,v3) -> do + core <- readIORef coreRef + case core of + Nothing -> do + box <- case getParameter paraDirection parameters of + Horizontal -> do + b <- hBoxNew False 1 + return (castToBox b) + Vertical -> do + b <- vBoxNew False 1 + return (castToBox b) + boxPackStart box frame1 PackGrow 0 + boxPackStart box frame2 PackGrow 0 + boxPackStart box frame3 PackGrow 0 + containerAdd widget box + inj1 v1 + inj2 v2 + inj3 v3 + writeIORef coreRef (Just (r1,r2,r3)) + Just ((_,inj1,_),(_,inj2,_),(_,inj3,_)) -> do + inj1 v1 + inj2 v2 + inj3 v3) + (do core <- readIORef coreRef + case core of + Nothing -> return Nothing + Just ((_,_,ext1),(_,_,ext2),(_,_,ext3)) -> do + r1 <- ext1 + r2 <- ext2 + r3 <- ext3 + if isJust r1 && isJust r2 && isJust r3 + then return (Just (fromJust r1,fromJust r2, fromJust r3)) + else return Nothing) + parameters + notifier + +{-- +tupel4Editor :: (Editor alpha, Parameters) + -> (Editor beta, Parameters) + -> (Editor gamma, Parameters) + -> (Editor delta, Parameters) + -> Editor (alpha,beta,gamma,delta) +tupel4Editor p1 p2 p3 p4 parameters notifier = do + (widg,inj,ext) <- pairEditor ((tupel3Editor p1 p2 p3), parameters) p4 parameters notifier + return (widg, + (\ (a, b, c, d) -> inj ((a,b,c),d)), + (do + mb <- ext + case mb of + Nothing -> return Nothing + Just ((a,b,c),d) -> return (Just (a,b,c,d)))) + +tupel5Editor :: (Editor alpha, Parameters) + -> (Editor beta, Parameters) + -> (Editor gamma, Parameters) + -> (Editor delta, Parameters) + -> (Editor epsilon, Parameters) + -> Editor (alpha,beta,gamma,delta,epsilon) +tupel5Editor p1 p2 p3 p4 p5 parameters notifier = do + (widg,inj,ext) <- pairEditor ((tupel4Editor p1 p2 p3 p4), parameters) p5 parameters notifier + return (widg, + (\ (a, b, c, d, e) -> inj ((a,b,c,d),e)), + (do + mb <- ext + case mb of + Nothing -> return Nothing + Just ((a,b,c,d),e) -> return (Just (a,b,c,d,e)))) + +tupel6Editor :: (Editor alpha, Parameters) + -> (Editor beta, Parameters) + -> (Editor gamma, Parameters) + -> (Editor delta, Parameters) + -> (Editor epsilon, Parameters) + -> (Editor zeta, Parameters) + -> Editor (alpha,beta,gamma,delta,epsilon,zeta) +tupel6Editor p1 p2 p3 p4 p5 p6 parameters notifier = do + (widg,inj,ext) <- pairEditor ((tupel5Editor p1 p2 p3 p4 p5), parameters) p6 parameters notifier + return (widg, + (\ (a, b, c, d, e, f) -> inj ((a,b,c,d,e),f)), + (do + mb <- ext + case mb of + Nothing -> return Nothing + Just ((a,b,c,d,e),f) -> return (Just (a,b,c,d,e,f)))) + +tupel7Editor :: (Editor alpha, Parameters) + -> (Editor beta, Parameters) + -> (Editor gamma, Parameters) + -> (Editor delta, Parameters) + -> (Editor epsilon, Parameters) + -> (Editor zeta, Parameters) + -> (Editor eta, Parameters) + -> Editor (alpha,beta,gamma,delta,epsilon,zeta,eta) +tupel7Editor p1 p2 p3 p4 p5 p6 p7 parameters notifier = do + (widg,inj,ext) <- pairEditor ((tupel6Editor p1 p2 p3 p4 p5 p6), parameters) p7 parameters notifier + return (widg, + (\ (a, b, c, d, e, f, g) -> inj ((a,b,c,d,e,f),g)), + (do + mb <- ext + case mb of + Nothing -> return Nothing + Just ((a,b,c,d,e,f),g) -> return (Just (a,b,c,d,e,f,g)))) +--} + -- -- | Like a pair editor, but with a moveable split -- @@ -173,10 +318,12 @@ Just val -> if hasChild then do + inj1 positive (childWidget,inj2,_) <- getChildEditor childRef childEdit childParams cNoti widgetShowAll childWidget inj2 val else do + inj1 positive (childWidget,inj2,_) <- getChildEditor childRef childEdit childParams cNoti boxPackEnd box childWidget PackGrow 0 widgetShowAll childWidget @@ -251,9 +398,9 @@ noti2 <- emptyNotifier noti3 <- emptyNotifier mapM_ (propagateEvent notifier [noti1,noti2,noti3]) allGUIEvents - be@(boolFrame,inj1,ext1) <- boolEditor2 label2 parameters noti1 - le@(leftFrame,inj2,ext2) <- leftEditor leftParams noti2 - re@(rightFrame,inj3,ext3) <- rightEditor rightParams noti3 + be@(boolFrame,inj1,ext1) <- boolEditor2 (getParameter paraName rightParams) leftParams noti1 + le@(leftFrame,inj2,ext2) <- leftEditor (paraName <<<- ParaName "" $ leftParams) noti2 + re@(rightFrame,inj3,ext3) <- rightEditor (paraName <<<- ParaName "" $ rightParams) noti3 mkEditor (\widget v -> do core <- readIORef coreRef @@ -343,15 +490,19 @@ -- -- | An editor with a subeditor, of which a list of items can be selected -multisetEditor :: (Show alpha, Default alpha) => - ColumnDescr alpha -> (Editor alpha, Parameters) -> Editor [alpha] -multisetEditor (ColumnDescr showHeaders columnsDD) (singleEditor, sParams) +multisetEditor :: (Show alpha, Default alpha, Eq alpha) => ColumnDescr alpha + -> (Editor alpha, Parameters) + -> Maybe ([alpha] -> [alpha]) -- ^ The 'mbSort' arg, a sort function if desired + -> Maybe (alpha -> alpha -> Bool) -- ^ The 'mbReplace' arg, a function which is a criteria for removing an + -- old entry when adding a new value + -> Editor [alpha] +multisetEditor (ColumnDescr showHeaders columnsDD) (singleEditor, sParams) mbSort mbReplace parameters notifier = do coreRef <- newIORef Nothing cnoti <- emptyNotifier mapM_ (propagateEvent notifier [cnoti]) allGUIEvents mkEditor - (\widget v -> do + (\widget vs -> do core <- readIORef coreRef case core of Nothing -> do @@ -370,43 +521,64 @@ containerAdd buttonBox addButton containerAdd buttonBox removeButton listStore <- listStoreNew ([]:: [alpha]) - list <- treeViewNewWithModel listStore + treeView <- treeViewNewWithModel listStore let minSize = getParameter paraMinSize parameters - uncurry (widgetSetSizeRequest list) minSize + uncurry (widgetSetSizeRequest treeView) minSize sw <- scrolledWindowNew Nothing Nothing - containerAdd sw list + containerAdd sw treeView scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic - sel <- treeViewGetSelection list + sel <- treeViewGetSelection treeView treeSelectionSetMode sel SelectionSingle mapM_ (\(str,func) -> do col <- treeViewColumnNew treeViewColumnSetTitle col str treeViewColumnSetResizable col True - treeViewAppendColumn list col + treeViewAppendColumn treeView col renderer <- cellRendererTextNew cellLayoutPackStart col renderer True cellLayoutSetAttributes col renderer listStore func ) columnsDD - treeViewSetHeadersVisible list showHeaders + treeViewSetHeadersVisible treeView showHeaders sel `onSelectionChanged` selectionHandler sel listStore injS boxPackStart box sw PackGrow 0 boxPackStart box buttonBox PackNatural 0 boxPackStart box frameS PackNatural 0 - activateEvent (castToWidget list) notifier Nothing FocusOut + activateEvent (castToWidget treeView) notifier Nothing FocusOut containerAdd widget box listStoreClear listStore - mapM_ (listStoreAppend listStore) v + mapM_ (listStoreAppend listStore) + (case mbSort of + Nothing -> vs + Just sortF -> sortF vs) addButton `onClicked` do mbv <- extS case mbv of Just v -> do - seq <- listStoreAppend listStore v - treeSelectionSelectPath sel [seq] - mbCol <- treeViewGetColumn list 0 - case mbCol of - Nothing -> return () - Just col -> treeViewScrollToCell list [seq] col Nothing - return () + case mbReplace of + Nothing -> return () + Just replaceF -> do + cont <- listStoreToList listStore + mapM_ (listStoreRemove listStore) + $ map fst + $ filter (\(_,e) -> replaceF v e) + $ zip [0..] cont + case mbSort of + Nothing -> do + listStoreAppend listStore v + return () + Just sortF -> do + cont <- listStoreToList listStore + listStoreClear listStore + mapM_ (listStoreAppend listStore) (sortF (v:cont)) + cont <- listStoreToList listStore + case elemIndex v cont of + Just idx -> do + treeSelectionSelectPath sel [idx] + mbCol <- treeViewGetColumn treeView 0 + case mbCol of + Nothing -> return () + Just col -> treeViewScrollToCell treeView [idx] col Nothing + Nothing -> return () Nothing -> return () removeButton `onClicked` do mbi <- treeSelectionGetSelected sel @@ -419,26 +591,19 @@ injS getDefault Just listStore -> do listStoreClear listStore - mapM_ (listStoreAppend listStore) v) + mapM_ (listStoreAppend listStore) + (case mbSort of + Nothing -> vs + Just sortF -> sortF vs)) (do core <- readIORef coreRef case core of Nothing -> return Nothing Just listStore -> do - v <- listStoreGetValues listStore + v <- listStoreToList listStore return (Just v)) (paraMinSize <<<- ParaMinSize (-1,-1) $ parameters) notifier where - listStoreGetValues :: ListStore a -> IO [a] - listStoreGetValues listStore = treeModelGetIterFirst listStore >>= getTail - where getTail mbi = case mbi of - Nothing -> return [] - Just iter -> do - [i] <- treeModelGetPath listStore iter - v <- listStoreGetValue listStore i - mbi2 <- treeModelIterNext listStore iter - rest <- getTail mbi2 - return (v : rest) selectionHandler :: TreeSelection -> ListStore a -> Injector a -> IO () selectionHandler sel listStore inj = do ts <- treeSelectionGetSelected sel @@ -449,4 +614,177 @@ v <- listStoreGetValue listStore i inj v return () + + +filesEditor :: Maybe FilePath -> FileChooserAction -> String -> Editor [FilePath] +filesEditor fp act label p = + multisetEditor + (ColumnDescr False [("",(\row -> [cellText := row]))]) + (fileEditor fp act label, emptyParams) + (Just sort) + (Just (==)) + (paraShadow <<<- ParaShadow ShadowIn $ + paraDirection <<<- ParaDirection Vertical $ p) + +stringsEditor :: (String -> Bool) -> Editor [String] +stringsEditor validation p = + multisetEditor + (ColumnDescr False [("",(\row -> [cellText := row]))]) + (stringEditor validation, emptyParams) + (Just sort) + (Just (==)) + (paraShadow <<<- ParaShadow ShadowIn $ p) + +dependencyEditor :: [PackageIdentifier] -> Editor Dependency +dependencyEditor packages para noti = do + (wid,inj,ext) <- pairEditor + ((eitherOrEditor (comboSelectionEditor ((sort . nub) (map (display . pkgName) packages)) id + , paraName <<<- ParaName "Select" $ emptyParams) + (stringEditor (const True), paraName <<<- ParaName "Enter" $ emptyParams) + "Select from list?"), paraName <<<- ParaName "Name"$ emptyParams) + (versionRangeEditor,paraName <<<- ParaName "Version" $ emptyParams) + (paraDirection <<<- ParaDirection Vertical $ para) + noti + let pinj (Dependency pn@(PackageName s) v) = if elem s (map (display . pkgName) packages) + then inj (Left s,v) + else inj (Right s,v) + let pext = do + mbp <- ext + case mbp of + Nothing -> return Nothing + Just (Left "",v) -> return Nothing + Just (Left s,v) -> return (Just $ Dependency (PackageName s) v) + Just (Right "",v) -> return Nothing + Just (Right s,v) -> return (Just $ Dependency (PackageName s) v) + return (wid,pinj,pext) + +dependenciesEditor :: [PackageIdentifier] -> Editor [Dependency] +dependenciesEditor packages p noti = + multisetEditor + (ColumnDescr True [("Package",\(Dependency (PackageName str) _) -> [cellText := str]) + ,("Version",\(Dependency _ vers) -> [cellText := display vers])]) + (dependencyEditor packages, + paraOuterAlignment <<<- ParaInnerAlignment (0.0, 0.5, 1.0, 1.0) + $ paraInnerAlignment <<<- ParaOuterAlignment (0.0, 0.5, 1.0, 1.0) + $ emptyParams) + (Just (sortBy (\ (Dependency p1 _) (Dependency p2 _) -> compare p1 p2))) + (Just (\ (Dependency p1 _) (Dependency p2 _) -> p1 == p2)) + (paraShadow <<<- ParaShadow ShadowIn $ + paraOuterAlignment <<<- ParaInnerAlignment (0.0, 0.5, 1.0, 1.0) + $ paraInnerAlignment <<<- ParaOuterAlignment (0.0, 0.5, 1.0, 1.0) + $ paraDirection <<<- ParaDirection Vertical + $ paraPack <<<- ParaPack PackGrow + $ p) + noti + +versionRangeEditor :: Editor VersionRange +versionRangeEditor para noti = do + (wid,inj,ext) <- + maybeEditor + ((eitherOrEditor + (pairEditor + (comboSelectionEditor v1 show, emptyParams) + (versionEditor, paraName <<<- ParaName "Enter Version" $ emptyParams), + (paraDirection <<<- ParaDirection Vertical + $ paraName <<<- ParaName "Simple" + $ paraOuterAlignment <<<- ParaOuterAlignment (0.0, 0.0, 0.0, 0.0) + $ paraOuterPadding <<<- ParaOuterPadding (0, 0, 0, 0) + $ paraInnerAlignment <<<- ParaInnerAlignment (0.0, 0.0, 0.0, 0.0) + $ paraInnerPadding <<<- ParaInnerPadding (0, 0, 0, 0) + $ emptyParams)) + (tupel3Editor + (comboSelectionEditor v2 show, emptyParams) + (versionRangeEditor, paraShadow <<<- ParaShadow ShadowIn $ emptyParams) + (versionRangeEditor, paraShadow <<<- ParaShadow ShadowIn $ emptyParams), + paraName <<<- ParaName "Complex" + $ paraDirection <<<- ParaDirection Vertical + $ paraOuterAlignment <<<- ParaOuterAlignment (0.0, 0.0, 0.0, 0.0) + $ paraOuterPadding <<<- ParaOuterPadding (0, 0, 0, 0) + $ paraInnerAlignment <<<- ParaInnerAlignment (0.0, 0.0, 0.0, 0.0) + $ paraInnerPadding <<<- ParaInnerPadding (0, 0, 0, 0) + $ emptyParams) "Select version range"), emptyParams) + False "Any Version" + (paraDirection <<<- ParaDirection Vertical $ para) + noti + let vrinj AnyVersion = inj Nothing + vrinj (ThisVersion v) = inj (Just (Left (ThisVersionS,v))) + vrinj (LaterVersion v) = inj (Just (Left (LaterVersionS,v))) + vrinj (EarlierVersion v) = inj (Just (Left (EarlierVersionS,v))) + vrinj (UnionVersionRanges (ThisVersion v1) (LaterVersion v2)) | v1 == v2 + = inj (Just (Left (ThisOrLaterVersionS,v1))) + vrinj (UnionVersionRanges (LaterVersion v1) (ThisVersion v2)) | v1 == v2 + = inj (Just (Left (ThisOrLaterVersionS,v1))) + vrinj (UnionVersionRanges (ThisVersion v1) (EarlierVersion v2)) | v1 == v2 + = inj (Just (Left (ThisOrEarlierVersionS,v1))) + vrinj (UnionVersionRanges (EarlierVersion v1) (ThisVersion v2)) | v1 == v2 + = inj (Just (Left (ThisOrEarlierVersionS,v1))) + vrinj (UnionVersionRanges v1 v2)= inj (Just (Right (UnionVersionRangesS,v1,v2))) + vrinj (IntersectVersionRanges v1 v2) + = inj (Just (Right (IntersectVersionRangesS,v1,v2))) + let vrext = do mvr <- ext + case mvr of + Nothing -> return (Just AnyVersion) + Just Nothing -> return (Just AnyVersion) + Just (Just (Left (ThisVersionS,v))) -> return (Just (ThisVersion v)) + Just (Just (Left (LaterVersionS,v))) -> return (Just (LaterVersion v)) + Just (Just (Left (EarlierVersionS,v))) -> return (Just (EarlierVersion v)) + + Just (Just (Left (ThisOrLaterVersionS,v))) -> return (Just (orLaterVersion v)) + Just (Just (Left (ThisOrEarlierVersionS,v))) -> return (Just (orEarlierVersion v)) + Just (Just (Right (UnionVersionRangesS,v1,v2))) + -> return (Just (UnionVersionRanges v1 v2)) + Just (Just (Right (IntersectVersionRangesS,v1,v2))) + -> return (Just (IntersectVersionRanges v1 v2)) + return (wid,vrinj,vrext) + where + v1 = [ThisVersionS,LaterVersionS,ThisOrLaterVersionS,EarlierVersionS,ThisOrEarlierVersionS] + v2 = [UnionVersionRangesS,IntersectVersionRangesS] + +data Version1 = ThisVersionS | LaterVersionS | ThisOrLaterVersionS | EarlierVersionS | ThisOrEarlierVersionS + deriving (Eq) +instance Show Version1 where + show ThisVersionS = "This Version" + show LaterVersionS = "Later Version" + show ThisOrLaterVersionS = "This or later Version" + show EarlierVersionS = "Earlier Version" + show ThisOrEarlierVersionS = "This or earlier Version" + +data Version2 = UnionVersionRangesS | IntersectVersionRangesS + deriving (Eq) +instance Show Version2 where + show UnionVersionRangesS = "Union Version Ranges" + show IntersectVersionRangesS = "Intersect Version Ranges" + +versionEditor :: Editor Version +versionEditor para noti = do + (wid,inj,ext) <- stringEditor (\s -> not (null s)) para noti + let pinj v = inj (display v) + let pext = do + s <- ext + case s of + Nothing -> return Nothing + Just s -> return (simpleParse s) + return (wid, pinj, pext) + +instance Default Version1 + where getDefault = ThisVersionS + +instance Default Version2 + where getDefault = UnionVersionRangesS + +instance Default Version + where getDefault = forceJust (simpleParse "0") "PackageEditor>>default version" + +instance Default VersionRange + where getDefault = AnyVersion + +instance Default Dependency + where getDefault = Dependency getDefault getDefault + +instance Default PackageName + where getDefault = PackageName getDefault + + + + diff --git a/src/Graphics/UI/Editor/Simple.hs b/src/Graphics/UI/Editor/Simple.hs --- a/src/Graphics/UI/Editor/Simple.hs +++ b/src/Graphics/UI/Editor/Simple.hs @@ -23,6 +23,7 @@ , fontEditor , comboSelectionEditor , staticListEditor +, staticListEditor2 , multiselectionEditor , fileEditor , otherEditor @@ -45,6 +46,7 @@ import Graphics.UI.Editor.Basics import Graphics.UI.Editor.MakeEditor import Control.Event +import Graphics.UI.Gtk.Gdk.Events (Event(..)) -- ------------------------------------------------------------ -- * Simple Editors @@ -278,7 +280,7 @@ return (wid,ginj,gext) -- --- | Editor for a boolean value in the form of a check button +-- | Editor for no value, it only emtis a clicked event and has the form of a check button -- buttonEditor :: Editor () buttonEditor parameters notifier = do @@ -303,8 +305,8 @@ -- | Editor for the selection of some element from a static list of elements in the -- | form of a combo box -comboSelectionEditor :: (Show beta, Eq beta) => [beta] -> Editor beta -comboSelectionEditor list parameters notifier = do +comboSelectionEditor :: Eq beta => [beta] -> (beta -> String) -> Editor beta +comboSelectionEditor list showF parameters notifier = do coreRef <- newIORef Nothing mkEditor (\widget obj -> do @@ -312,7 +314,7 @@ case core of Nothing -> do combo <- comboBoxNewText - mapM_ (\o -> comboBoxAppendText combo (show o)) list + mapM_ (\o -> comboBoxAppendText combo (showF o)) list widgetSetName combo (getParameter paraName parameters) mapM_ (activateEvent (castToWidget combo) notifier Nothing) [FocusOut,FocusIn] @@ -387,10 +389,84 @@ -- -- | Editor for the selection of some elements from a static list of elements in the +-- | form of a list box with toggle elements + +staticListEditor :: (Eq beta) => [beta] -> (beta -> String) -> Editor [beta] +staticListEditor list showF parameters notifier = do + coreRef <- newIORef Nothing + mkEditor + (\widget objs -> do + core <- readIORef coreRef + case core of + Nothing -> do + listStore <- listStoreNew ([]:: [(Bool,beta)]) + listView <- treeViewNewWithModel listStore + widgetSetName listView (getParameter paraName parameters) + mapM_ (activateEvent (castToWidget listView) notifier Nothing) + [FocusOut,FocusIn] + sel <- treeViewGetSelection listView + treeSelectionSetMode sel + (case getParameter paraMultiSel parameters of + True -> SelectionMultiple + False -> SelectionSingle) + rendererToggle <- cellRendererToggleNew + set rendererToggle [cellToggleActivatable := True] + rendererText <- cellRendererTextNew + col1 <- treeViewColumnNew + treeViewAppendColumn listView col1 + cellLayoutPackStart col1 rendererToggle True + cellLayoutSetAttributes col1 rendererToggle listStore + $ \row -> [ cellToggleActive := fst row] + col2 <- treeViewColumnNew + treeViewAppendColumn listView col2 + cellLayoutPackStart col2 rendererText True + cellLayoutSetAttributes col2 rendererText listStore + $ \row -> [ cellText := showF (snd row)] + treeViewSetHeadersVisible listView False + listStoreClear listStore + mapM_ (listStoreAppend listStore) $ map (\e -> (elem e objs,e)) list + let minSize = getParameter paraMinSize parameters + uncurry (widgetSetSizeRequest listView) minSize + sw <- scrolledWindowNew Nothing Nothing + containerAdd sw listView + scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic + containerAdd widget sw + -- update the model when the toggle buttons are activated + on rendererToggle cellToggled $ \pathStr -> do + let (i:_) = stringToTreePath pathStr + val <- listStoreGetValue listStore i + listStoreSetValue listStore i (not (fst val),snd val) + listView `onKeyPress` (\event -> do + let Key { eventKeyName = name, eventModifier = modifier, eventKeyChar = char } = event + case (name, modifier, char) of + ("Return", _, _) -> do + sel <- treeViewGetSelection listView + rows <- treeSelectionGetSelectedRows sel + mapM_ (\ (i:_) -> do + val <- listStoreGetValue listStore i + listStoreSetValue listStore i (not (fst val),snd val)) rows + return True + _ -> return False) + writeIORef coreRef (Just (listView,listStore)) + Just (listView,listStore) -> do + let model = map (\e -> (elem e objs,e)) list + listStoreClear listStore + mapM_ (listStoreAppend listStore) $ map (\e -> (elem e objs,e)) list) + (do core <- readIORef coreRef + case core of + Nothing -> return Nothing + Just (listView,listStore) -> do + model <- listStoreToList listStore + return (Just (map snd $ filter (\e -> fst e) model))) + parameters + notifier + +-- +-- | Editor for the selection of some elements from a static list of elements in the -- | form of a list box -staticListEditor :: (Show beta, Eq beta) => [beta] -> Editor [beta] -staticListEditor list parameters notifier = do +staticListEditor2 :: (Eq beta) => [beta] -> (beta -> String) -> Editor [beta] +staticListEditor2 list showF parameters notifier = do coreRef <- newIORef Nothing mkEditor (\widget objs -> do @@ -412,7 +488,7 @@ treeViewAppendColumn listView col cellLayoutPackStart col renderer True cellLayoutSetAttributes col renderer listStore - $ \row -> [ cellText := show row ] + $ \row -> [ cellText := showF row ] treeViewSetHeadersVisible listView False listStoreClear listStore mapM_ (listStoreAppend listStore) list @@ -441,6 +517,7 @@ parameters notifier + -- -- | Editor for the selection of a file path in the form of a text entry and a button, -- | which opens a gtk file chooser @@ -458,7 +535,7 @@ [FocusOut,FocusIn,Clicked] entry <- entryNew widgetSetName entry $ getParameter paraName parameters ++ "-entry" - set entry [ entryEditable := False ] + -- set entry [ entryEditable := False ] mapM_ (activateEvent (castToWidget entry) notifier Nothing) [FocusOut,FocusIn] registerEvent notifier Clicked (Left (buttonHandler entry)) diff --git a/src/Graphics/UI/Frame/ViewFrame.hs b/src/Graphics/UI/Frame/ViewFrame.hs --- a/src/Graphics/UI/Frame/ViewFrame.hs +++ b/src/Graphics/UI/Frame/ViewFrame.hs @@ -213,8 +213,10 @@ mbPanePath <- getActivePanePath case mbPanePath of Nothing -> return () - Just panePath -> viewSplit' panePath dir + Just panePath -> do + viewSplit' panePath dir + viewSplit' :: PaneMonad alpha => PanePath -> Direction -> alpha () viewSplit' panePath dir = do activeNotebook <- getNotebook panePath @@ -257,10 +259,11 @@ liftIO $ afterSwitchPage nb handleFunc return (Just (paneDir,dir)) case mbPD of - Just (paneDir,dir) -> do + Just (paneDir,pdir) -> do let toPane = panePath ++ [paneDir] adjustPane panePath toPane - adjustLayoutForSplit dir panePath + adjustLayoutForSplit pdir panePath + viewMove (otherDirection paneDir) Nothing -> return () handleNotebookSwitch :: PaneMonad beta => Notebook -> Int -> beta () diff --git a/src/IDE/ImportTool.hs b/src/IDE/ImportTool.hs --- a/src/IDE/ImportTool.hs +++ b/src/IDE/ImportTool.hs @@ -334,15 +334,15 @@ -- |* The little dialog to choose between possible modules moduleFields :: [String] -> String -> FieldDescription String -moduleFields list id = +moduleFields list ident = mkField - (paraName <<<- ParaName ("From which module is " ++ id) + (paraName <<<- ParaName ("From which module is " ++ ident) $ paraMultiSel <<<- ParaMultiSel False $ paraMinSize <<<- ParaMinSize (300,400) $ emptyParams) (\ a -> [a]) (\ [a] b -> a) - (staticListEditor ((nub . sort) list)) + (staticListEditor ((nub . sort) list) id) selectModuleDialog :: [Descr] -> String -> Maybe Descr -> IO (Maybe Descr) selectModuleDialog list id mbDescr = do diff --git a/src/IDE/Leksah.hs b/src/IDE/Leksah.hs --- a/src/IDE/Leksah.hs +++ b/src/IDE/Leksah.hs @@ -50,7 +50,6 @@ import IDE.Pane.Preferences import IDE.Keymap import IDE.Pane.SourceBuffer -import IDE.SpecialEditors import IDE.Metainfo.Provider import IDE.Metainfo.SourceCollector import IDE.Metainfo.InterfaceCollector @@ -60,7 +59,7 @@ import IDE.GUIHistory import IDE.Pane.Search(setChoices,searchMetaGUI) import IDE.Find -import Graphics.UI.Editor.Composite (maybeEditor) +import Graphics.UI.Editor.Composite (filesEditor, maybeEditor) import Graphics.UI.Editor.Simple (fileEditor) --import Outputable (ppr,showSDoc) import IDE.Metainfo.GHCUtils (inGhcIO) @@ -175,12 +174,13 @@ uiManager <- uiManagerNew newIcons hasConfigDir' <- hasConfigDir - prefs <- if hasConfigDir' - then return iprefs - else do - firstStart iprefs - prefsPath <- getConfigFilePathForLoad "Default.prefs" - readPrefs prefsPath + (prefs,isFirstStart) <- if hasConfigDir' + then return (iprefs,False) + else do + firstStart iprefs + prefsPath <- getConfigFilePathForLoad "Default.prefs" + prefs <- readPrefs prefsPath + return (prefs,True) keysPath <- getConfigFilePathForLoad $ keymapName prefs ++ ".keymap" keyMap <- parseKeymap keysPath let accelActions = setKeymap (keyMap :: KeymapI) actions @@ -281,6 +281,9 @@ -- fontDescriptionSetSize fdesc (fromJust fds + 0.01) -- mapM_ (\buf -> widgetModifyFont (castToWidget $sourceView buf) (Just fdesc)) buffers -- end patch + when isFirstStart $ do + welcomePath <- getConfigFilePathForLoad $ "welcome.txt" + reflectIDE (fileOpenThis welcomePath) ideR reflectIDE (modifyIDE_ (\ide -> return ide{currentState = IsRunning})) ideR mainGUI diff --git a/src/IDE/Pane/Modules.hs b/src/IDE/Pane/Modules.hs --- a/src/IDE/Pane/Modules.hs +++ b/src/IDE/Pane/Modules.hs @@ -1028,7 +1028,7 @@ $ emptyParams) (\a -> [sourceRoot a]) (\ a b -> b{sourceRoot = forceHead a "Modules>>moduleFields"}) - (staticListEditor list), + (staticListEditor list id), mkField (paraName <<<- ParaName ("Is this an exposed library module") $ emptyParams) diff --git a/src/IDE/Pane/PackageEditor.hs b/src/IDE/Pane/PackageEditor.hs --- a/src/IDE/Pane/PackageEditor.hs +++ b/src/IDE/Pane/PackageEditor.hs @@ -36,7 +36,6 @@ import IDE.Core.State import IDE.FileUtils -import IDE.SpecialEditors import Graphics.UI.Editor.MakeEditor import Distribution.PackageDescription.Parse (readPackageDescription,writePackageDescription) import Distribution.PackageDescription.Configuration (freeVars,flattenPackageDescription) @@ -44,13 +43,57 @@ import Data.Typeable (Typeable(..)) import Debug.Trace (trace) import qualified Distribution.InstalledPackageInfo as IPI (package) -import Graphics.UI.Editor.Composite (maybeEditor,pairEditor,ColumnDescr(..),multisetEditor) -import Distribution.Text (simpleParse,display) +import Graphics.UI.Editor.Composite + (versionEditor, + versionRangeEditor, + dependenciesEditor, + stringsEditor, + filesEditor, + tupel3Editor, + eitherOrEditor, + maybeEditor, + pairEditor, + ColumnDescr(..), + multisetEditor) +import Distribution.Text (simpleParse, display) import MyMissing -import Graphics.UI.Editor.Parameters (Parameter(..),paraPack,Direction(..),paraDirection,paraMinSize,paraShadow,paraSynopsis,(<<<-),emptyParams,paraName,getParameterPrim) -import Graphics.UI.Editor.Simple (boolEditor,fileEditor,comboSelectionEditor,multilineStringEditor,stringEditor) +import Graphics.UI.Editor.Parameters + (paraMultiSel, + paraInnerPadding, + paraInnerAlignment, + paraOuterPadding, + paraOuterAlignment, + Parameter(..), + paraPack, + Direction(..), + paraDirection, + paraMinSize, + paraShadow, + paraSynopsis, + (<<<-), + emptyParams, + paraName, + getParameterPrim) +import Graphics.UI.Editor.Simple + (intEditor, + staticListEditor, + boolEditor, + fileEditor, + comboSelectionEditor, + multilineStringEditor, + stringEditor) import Distribution.License (License(..)) import IDE.Metainfo.GHCUtils (inGhc,getInstalledPackageInfos) +import Graphics.UI.Editor.Basics (Editor(..)) +import Distribution.Compiler + (CompilerFlavor(..)) +import Distribution.Simple + (knownExtensions, + Extension(..), + VersionRange(..)) +import Distribution.Version + (VersionRange(..)) +import Default (Default(..)) -- --------------------------------------------------------------------- -- The exported stuff goes here @@ -421,7 +464,7 @@ (paraName <<<- ParaName "Description" $ paraSynopsis <<<- ParaSynopsis "A more verbose description of this package" $ paraShadow <<<- ParaShadow ShadowOut - $ paraMinSize <<<- ParaMinSize (-1,250) + $ paraMinSize <<<- ParaMinSize (-1,210) $ emptyParams) (description . pd) (\ a b -> b{pd = (pd b){description = if null a then " \n\n\n\n\n" else a}}) @@ -452,7 +495,7 @@ (paraName <<<- ParaName "License" $ emptyParams) (license . pd) (\ a b -> b{pd = (pd b){license = a}}) - (comboSelectionEditor [GPL, LGPL, BSD3, BSD4, PublicDomain, AllRightsReserved, OtherLicense]) + (comboSelectionEditor [GPL, LGPL, BSD3, BSD4, PublicDomain, AllRightsReserved, OtherLicense] show) , mkField (paraName <<<- ParaName "License File" $ emptyParams) (licenseFile . pd) @@ -473,13 +516,24 @@ (maintainer . pd) (\ a b -> b{pd = (pd b){maintainer = a}}) (stringEditor (const True)) + , mkField + (paraName <<<- ParaName "Bug Reports" $ emptyParams) + (bugReports . pd) + (\ a b -> b{pd = (pd b){bugReports = a}}) + (stringEditor (const True)) ]), +-- ("Repositories", VFD emptyParams [ +-- mkField +-- (paraName <<<- ParaName "Source Repositories" $ emptyParams) +-- (sourceRepos . pd) +-- (\ a b -> b{pd = (pd b){sourceRepos = a}}) +-- reposEditor]), ("Dependencies ", VFD emptyParams [ mkField (paraName <<<- ParaName "Build Dependencies" $ paraSynopsis <<<- ParaSynopsis "Does this package depends on other packages?" $ paraDirection <<<- ParaDirection Vertical - $ paraPack <<<- ParaPack PackGrow + $ paraMinSize <<<- ParaMinSize (-1,250) $ emptyParams) (reverse . buildDepends . pd) (\ a b -> b{pd = (pd b){buildDepends = a}}) @@ -503,25 +557,32 @@ [] -> []--(GHC,AnyVersion)] l -> l) (\ a b -> b{pd = (pd b){testedWith = a}}) - testedWidthEditor + testedWithEditor ]), - ("Extra Files", VFD emptyParams [ + ("Data Files", VFD emptyParams [ mkField (paraName <<<- ParaName "Data Files" $ paraSynopsis <<<- ParaSynopsis "A list of files to be installed for run-time use by the package." $ paraDirection <<<- ParaDirection Vertical - $ paraMinSize <<<- ParaMinSize (-1,130) + $ paraMinSize <<<- ParaMinSize (-1,250) $ emptyParams) (dataFiles . pd) (\ a b -> b{pd = (pd b){dataFiles = a}}) (filesEditor (Just fp) FileChooserActionOpen "Select File") , mkField + (paraName <<<- ParaName "Data directory" $ emptyParams) + (dataDir . pd) + (\ a b -> b{pd = (pd b){dataDir = a}}) + (fileEditor (Just fp) FileChooserActionSelectFolder "Select file") + ]), + ("Extra Files", VFD emptyParams [ + mkField (paraName <<<- ParaName "Extra Source Files" $ paraSynopsis <<<- ParaSynopsis "A list of additional files to be included in source distributions." $ paraDirection <<<- ParaDirection Vertical - $ paraMinSize <<<- ParaMinSize (-1,130) + $ paraMinSize <<<- ParaMinSize (-1,120) $ emptyParams) (extraSrcFiles . pd) (\ a b -> b{pd = (pd b){extraSrcFiles = a}}) @@ -531,12 +592,38 @@ $ paraSynopsis <<<- ParaSynopsis "A list of additional files or directories to be removed by setup clean." $ paraDirection <<<- ParaDirection Vertical - $ paraMinSize <<<- ParaMinSize (-1,130) + $ paraMinSize <<<- ParaMinSize (-1,120) $ emptyParams) (extraTmpFiles . pd) (\ a b -> b{pd = (pd b){extraTmpFiles = a}}) (filesEditor (Just fp) FileChooserActionOpen "Select File") ]), + ("Other",VFD emptyParams [ + mkField + (paraName <<<- ParaName "Build Type" + $ paraSynopsis <<<- ParaSynopsis + "Describe executable programs contained in the package" + $ paraShadow <<<- ParaShadow ShadowIn + $ paraDirection <<<- ParaDirection Vertical + $ emptyParams) + (buildType . pd) + (\ a b -> b{pd = (pd b){buildType = a}}) + (maybeEditor (buildTypeEditor, emptyParams) True "Specify?") + , mkField + (paraName <<<- ParaName "Custom Fields" + $ paraShadow <<<- ParaShadow ShadowIn + $ paraDirection <<<- ParaDirection Vertical $ emptyParams) + (customFieldsPD . pd) + (\ a b -> b{pd = (pd b){customFieldsPD = a}}) + (multisetEditor + (ColumnDescr True [("Name",\(n,_) -> [cellText := n]) + ,("Value",\(_,v) -> [cellText := v])]) + ((pairEditor + (stringxEditor (const True),emptyParams) + (stringEditor (const True),emptyParams)),emptyParams) + Nothing + Nothing) + ]), ("Executables",VFD emptyParams [ mkField (paraName <<<- ParaName "Executables" @@ -553,13 +640,11 @@ $ paraSynopsis <<<- ParaSynopsis "If the package contains a library, specify the exported modules here" $ paraDirection <<<- ParaDirection Vertical - $ paraPack <<<- ParaPack PackGrow $ paraShadow <<<- ParaShadow ShadowIn $ emptyParams) mbLib (\ a b -> b{mbLib = a}) (maybeEditor (libraryEditor (Just fp) modules numBuildInfos, paraName <<<- ParaName "Specify exported modules" - $ paraPack <<<- ParaPack PackGrow $ emptyParams) True "Does this package contain a library?") ]) @@ -597,7 +682,7 @@ ++ "not exposed to users.") $ paraShadow <<<- ParaShadow ShadowIn $ paraDirection <<<- ParaDirection Vertical - $ paraMinSize <<<- ParaMinSize (-1,400) + $ paraMinSize <<<- ParaMinSize (-1,300) $ paraPack <<<- ParaPack PackGrow $ emptyParams) (map display. otherModules . (\a -> a !! i) . bis) @@ -619,18 +704,23 @@ ,("Options",\(_,op) -> [cellText := concatMap (\s -> ' ' : s) op])]) ((pairEditor (compilerFlavorEditor,emptyParams) - (stringsEditor (const True),emptyParams)), + (optsEditor,emptyParams)), (paraDirection <<<- ParaDirection Vertical - $ paraMinSize <<<- ParaMinSize (-1,400) - $ paraPack <<<- ParaPack PackGrow - $ paraShadow <<<- ParaShadow ShadowIn $ emptyParams))) + $ paraShadow <<<- ParaShadow ShadowIn $ emptyParams)) + Nothing + Nothing) , mkField (paraName <<<- ParaName "Additional options for GHC when built with profiling" - $ paraDirection <<<- ParaDirection Vertical $ emptyParams) (ghcProfOptions . (\a -> a !! i) . bis) (\ a b -> b{bis = update (bis b) i (\bi -> bi{ghcProfOptions = a})}) - (stringsEditor (const True)) + optsEditor + , mkField + (paraName <<<- ParaName "Additional options for GHC when the package is built as shared library" + $ emptyParams) + (ghcSharedOptions . (\a -> a !! i) . bis) + (\ a b -> b{bis = update (bis b) i (\bi -> bi{ghcSharedOptions = a})}) + optsEditor ]), (show (i + 1) ++ " Extensions ", VFD emptyParams [ mkField @@ -644,21 +734,41 @@ (\ a b -> b{bis = update (bis b) i (\bi -> bi{extensions = a})}) extensionsEditor ]), - (show (i + 1) ++ " Opts C ", VFD emptyParams [ + (show (i + 1) ++ " Build Tools ", VFD emptyParams [ + mkField + (paraName <<<- ParaName "Tools needed for a build" + $ paraDirection <<<- ParaDirection Vertical + $ paraMinSize <<<- ParaMinSize (-1,120) + $ emptyParams) + (buildTools . (\a -> a !! i) . bis) + (\ a b -> b{bis = update (bis b) i (\bi -> bi{buildTools = a})}) + (dependenciesEditor []) + ]), + (show (i + 1) ++ " Pkg Config ", VFD emptyParams [ + mkField + (paraName <<<- ParaName "A list of pkg-config packages, needed to build this package" + $ paraDirection <<<- ParaDirection Vertical + $ paraMinSize <<<- ParaMinSize (-1,120) + $ emptyParams) + (pkgconfigDepends . (\a -> a !! i) . bis) + (\ a b -> b{bis = update (bis b) i (\bi -> bi{pkgconfigDepends = a})}) + (dependenciesEditor []) + ]), + (show (i + 1) ++ " Opts C -1-", VFD emptyParams [ mkField (paraName <<<- ParaName "Options for C compiler" $ paraDirection <<<- ParaDirection Vertical $ emptyParams) (ccOptions . (\a -> a !! i) . bis) (\ a b -> b{bis = update (bis b) i (\bi -> bi{ccOptions = a})}) - (stringsEditor (const True)) + optsEditor , mkField (paraName <<<- ParaName "Options for linker" $ paraDirection <<<- ParaDirection Vertical $ emptyParams) (ldOptions . (\a -> a !! i) . bis) (\ a b -> b{bis = update (bis b) i (\bi -> bi{ldOptions = a})}) - (stringsEditor (const True)) + optsEditor , mkField (paraName <<<- ParaName "A list of header files already installed on the system" $ paraDirection <<<- ParaDirection Vertical $ emptyParams) @@ -672,7 +782,7 @@ (\ a b -> b{bis = update (bis b) i (\bi -> bi{installIncludes = a})}) (filesEditor fp FileChooserActionOpen "Select File") ]), - (show (i + 1) ++ " More Opts C", VFD emptyParams [ + (show (i + 1) ++ " Opts C -2-", VFD emptyParams [ mkField (paraName <<<- ParaName "A list of directories to search for header files" $ paraDirection <<<- ParaDirection Vertical $ emptyParams) @@ -686,7 +796,9 @@ (cSources . (\a -> a !! i) . bis) (\ a b -> b{bis = update (bis b) i (\bi -> bi{cSources = a})}) (filesEditor fp FileChooserActionOpen "Select file") - , mkField + ]), + (show (i + 1) ++ " Opts Libs ", VFD emptyParams [ + mkField (paraName <<<- ParaName "A list of extra libraries to link with" $ paraDirection <<<- ParaDirection Vertical $ emptyParams) (extraLibs . (\a -> a !! i) . bis) @@ -699,12 +811,363 @@ (\ a b -> b{bis = update (bis b) i (\bi -> bi{extraLibDirs = a})}) (filesEditor fp FileChooserActionSelectFolder "Select Folder") ]), - (show (i + 1) ++ " Opts OSX", VFD emptyParams [ + (show (i + 1) ++ " Other", VFD emptyParams [ mkField (paraName <<<- ParaName "Support frameworks for Mac OS X" $ paraDirection <<<- ParaDirection Vertical $ emptyParams) - (cSources . (\a -> a !! i) . bis) - (\ a b -> b{bis = update (bis b) i (\bi -> bi{cSources = a})}) + (frameworks . (\a -> a !! i) . bis) + (\ a b -> b{bis = update (bis b) i (\bi -> bi{frameworks = a})}) (stringsEditor (const True)) - ])] + , mkField + (paraName <<<- ParaName "Custom fields build info" + $ paraShadow <<<- ParaShadow ShadowIn + $ paraDirection <<<- ParaDirection Vertical $ emptyParams) + (customFieldsBI . (\a -> a !! i) . bis) + (\ a b -> b{bis = update (bis b) i (\bi -> bi{customFieldsBI = a})}) + (multisetEditor + (ColumnDescr True [("Name",\(n,_) -> [cellText := n]) + ,("Value",\(_,v) -> [cellText := v])]) + ((pairEditor + (stringxEditor (const True),emptyParams) + (stringEditor (const True),emptyParams)),emptyParams) + Nothing + Nothing) + ])] + +stringxEditor :: (String -> Bool) -> Editor String +stringxEditor val para noti = do + (wid,inj,ext) <- stringEditor val para noti + let + xinj ("") = inj "" + xinj ('x':'-':rest) = inj rest + xinj _ = throwIDE "PackageEditor>>stringxEditor: field without leading x-" + xext = do + res <- ext + case res of + Nothing -> return Nothing + Just str -> return (Just ("x-" ++ str)) + return (wid,xinj,xext) + +optsEditor :: Editor [String] +optsEditor para noti = do + (wid,inj,ext) <- stringEditor (const True) para noti + let + oinj = inj . unwords + oext = do + res <- ext + case res of + Nothing -> return Nothing + Just str -> return (Just (words str)) + return (wid,oinj,oext) + +packageEditor :: Editor PackageIdentifier +packageEditor para noti = do + (wid,inj,ext) <- pairEditor + (stringEditor (\s -> not (null s)), paraName <<<- ParaName "Name" $ emptyParams) + (versionEditor, paraName <<<- ParaName "Version" $ emptyParams) + (paraDirection <<<- ParaDirection Horizontal + $ paraShadow <<<- ParaShadow ShadowIn + $ para) noti + let pinj (PackageIdentifier (PackageName n) v) = inj (n,v) + let pext = do + mbp <- ext + case mbp of + Nothing -> return Nothing + Just (n,v) -> do + if null n + then return Nothing + else return (Just $PackageIdentifier (PackageName n) v) + return (wid,pinj,pext) + +testedWithEditor :: Editor [(CompilerFlavor, VersionRange)] +testedWithEditor para = do + multisetEditor + (ColumnDescr True [("Compiler Flavor",\(cv,_) -> [cellText := show cv]) + ,("Version Range",\(_,vr) -> [cellText := display vr])]) + (pairEditor + (compilerFlavorEditor, paraShadow <<<- (ParaShadow ShadowNone) $ emptyParams) + (versionRangeEditor, paraShadow <<<- (ParaShadow ShadowNone) $ emptyParams), + (paraDirection <<<- (ParaDirection Vertical) $ emptyParams)) + Nothing + (Just (==)) + para + +compilerFlavorEditor :: Editor CompilerFlavor +compilerFlavorEditor para noti = do + (wid,inj,ext) <- eitherOrEditor + (comboSelectionEditor flavors show, paraName <<<- (ParaName "Select compiler") $ emptyParams) + (stringEditor (\s -> not (null s)), paraName <<<- (ParaName "Specify compiler") $ emptyParams) + "Other" + (paraName <<<- ParaName "Select" $ para) + noti + let cfinj comp = case comp of + (OtherCompiler str) -> inj (Right str) + other -> inj (Left other) + let cfext = do + mbp <- ext + case mbp of + Nothing -> return Nothing + Just (Right s) -> return (Just $OtherCompiler s) + Just (Left other) -> return (Just other) + return (wid,cfinj,cfext) + where + flavors = [GHC, NHC, Hugs, HBC, Helium, JHC] + +buildTypeEditor :: Editor BuildType +buildTypeEditor para noti = do + (wid,inj,ext) <- eitherOrEditor + (comboSelectionEditor flavors show, paraName <<<- (ParaName "Select") $ emptyParams) + (stringEditor (const True), paraName <<<- (ParaName "Unknown") $ emptyParams) + "Unknown" + (paraName <<<- ParaName "Select" $ para) + noti + let cfinj comp = case comp of + (UnknownBuildType str) -> inj (Right str) + other -> inj (Left other) + let cfext = do + mbp <- ext + case mbp of + Nothing -> return Nothing + Just (Right s) -> return (Just $ UnknownBuildType s) + Just (Left other) -> return (Just other) + return (wid,cfinj,cfext) + where + flavors = [Simple, Configure, Make, Custom] + +extensionsEditor :: Editor [Extension] +extensionsEditor p = staticListEditor extensionsL show (paraMultiSel <<<- ParaMultiSel True $ p) + + +extensionsL :: [Extension] +extensionsL = knownExtensions + +{-- +reposEditor :: Editor [SourceRepo] +reposEditor p noti = + multisetEditor + (ColumnDescr False [("",\repo -> [cellText := display repo])]) + (repoEditor, + paraOuterAlignment <<<- ParaInnerAlignment (0.0, 0.5, 1.0, 1.0) + $ paraInnerAlignment <<<- ParaOuterAlignment (0.0, 0.5, 1.0, 1.0) + $ emptyParams) + Nothing + Nothing + (paraShadow <<<- ParaShadow ShadowIn $ + paraOuterAlignment <<<- ParaInnerAlignment (0.0, 0.5, 1.0, 1.0) + $ paraInnerAlignment <<<- ParaOuterAlignment (0.0, 0.5, 1.0, 1.0) + $ paraDirection <<<- ParaDirection Vertical + $ paraPack <<<- ParaPack PackGrow + $ p) + noti + +instance Text SourceRepo where + disp (SourceRepo repoKind repoType repoLocation repoModule repoBranch repoTag repoSubdir) + = disp repoKind + <+> case repoType of + Nothing -> empty + Just repoT -> disp repoT + <+> case repoLocation of + Nothing -> empty + Just repoL -> text repoL + +repoEditor :: Editor SourceRepo +repoEditor paras noti = do + (widg,inj,ext) <- tupel7Editor + (repoKindEditor,noBorder) + (maybeEditor (repoTypeEditor,noBorder) True "Specify a type", emptyParams) + (maybeEditor (stringEditor (const True),noBorder) True "Specify a location", emptyParams) + (maybeEditor (stringEditor (const True),noBorder) True "Specify a module", emptyParams) + (maybeEditor (stringEditor (const True),noBorder) True "Specify a branch", emptyParams) + (maybeEditor (stringEditor (const True),noBorder) True "Specify a tag", emptyParams) + (maybeEditor (stringEditor (const True),noBorder) True "Specify a subdir", emptyParams) + (paraDirection <<<- ParaDirection Vertical $ noBorder) + noti + return (widg, + (\ r -> inj (repoKind r,repoType r,repoLocation r,repoModule r,repoBranch r,repoTag r,repoSubdir r)), + (do + mb <- ext + case mb of + Nothing -> return Nothing + Just (a,b,c,d,e,f,g) -> return (Just (SourceRepo a b c d e f g)))) + where noBorder = paraOuterAlignment <<<- ParaOuterAlignment (0.0, 0.0, 0.0, 0.0) + $ paraOuterPadding <<<- ParaOuterPadding (0, 0, 0, 0) + $ paraInnerAlignment <<<- ParaInnerAlignment (0.0, 0.0, 0.0, 0.0) + $ paraInnerPadding <<<- ParaInnerPadding (0, 0, 0, 0) + $ emptyParams + +repoKindEditor :: Editor RepoKind +repoKindEditor paras noti = do + (widg,inj,ext) <- pairEditor + (comboSelectionEditor selectionList show, emptyParams) + (stringEditor (const True),emptyParams) + paras + noti + return (widg, + (\kind -> case kind of + RepoKindUnknown str -> inj (RepoKindUnknown "",str) + other -> inj (other,"")), + (do + mbRes <- ext + case mbRes of + Nothing -> return Nothing + Just (RepoKindUnknown "",str) -> return (Just (RepoKindUnknown str)) + Just (other,_) -> return (Just other))) + where selectionList = [RepoHead, RepoThis, RepoKindUnknown ""] + +repoTypeEditor :: Editor RepoType +repoTypeEditor paras noti = do + (widg,inj,ext) <- pairEditor + (comboSelectionEditor selectionList show, emptyParams) + (stringEditor (const True),emptyParams) + paras + noti + return (widg, + (\kind -> case kind of + OtherRepoType str -> inj (OtherRepoType "",str) + other -> inj (other,"")), + (do + mbRes <- ext + case mbRes of + Nothing -> return Nothing + Just (OtherRepoType "",str) -> return (Just (OtherRepoType str)) + Just (other,_) -> return (Just other))) + where selectionList = [Darcs, Git, SVN, CVS, Mercurial, GnuArch, Bazaar, Monotone, OtherRepoType ""] +--} + +-- ------------------------------------------------------------ +-- * BuildInfos +-- ------------------------------------------------------------ + +data Library' = Library'{ + exposedModules' :: [ModuleName] +, libExposed' :: Bool +, libBuildInfoIdx :: Int} + deriving (Show, Eq) + +data Executable' = Executable'{ + exeName' :: String +, modulePath' :: FilePath +, buildInfoIdx :: Int} + deriving (Show, Eq) + +instance Default Library' + where getDefault = Library' [] getDefault getDefault + +instance Default Executable' + where getDefault = Executable' getDefault getDefault getDefault + + +libraryEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor Library' +libraryEditor fp modules numBuildInfos para noti = do + (wid,inj,ext) <- + tupel3Editor + (boolEditor, + paraName <<<- ParaName "Exposed" + $ paraSynopsis <<<- ParaSynopsis "Is the lib to be exposed by default?" + $ emptyParams) + (modulesEditor modules, + paraName <<<- ParaName "Exposed Modules" + $ paraMinSize <<<- ParaMinSize (-1,300) + $ para) + (buildInfoEditorP numBuildInfos, paraName <<<- ParaName "Build Info" + $ paraPack <<<- ParaPack PackNatural + $ para) + (paraDirection <<<- ParaDirection Vertical + $ emptyParams) + noti + let pinj (Library' em exp bi) = inj (exp, map display em,bi) + let pext = do + mbp <- ext + case mbp of + Nothing -> return Nothing + Just (exp,em,bi) -> return (Just $ Library' (map (\s -> forceJust (simpleParse s) + "SpecialEditor >> libraryEditor: no parse for moduile name") em) exp bi) + return (wid,pinj,pext) + +--moduleEditor :: [ModuleName] -> Editor String +--moduleEditor modules = comboSelectionEditor (map display modules) + +modulesEditor :: [ModuleName] -> Editor [String] +modulesEditor modules = staticListEditor (map display modules) id + +executablesEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor [Executable'] +executablesEditor fp modules countBuildInfo p = + multisetEditor + (ColumnDescr True [("Executable Name",\(Executable' exeName _ _) -> [cellText := exeName]) + ,("Module Path",\(Executable' _ mp _) -> [cellText := mp]) + + ,("Build info index",\(Executable' _ _ bii) -> [cellText := show (bii + 1)])]) + (executableEditor fp modules countBuildInfo,emptyParams) + Nothing + Nothing + (paraShadow <<<- ParaShadow ShadowIn $ p) + +executableEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor Executable' +executableEditor fp modules countBuildInfo para noti = do + (wid,inj,ext) <- tupel3Editor + (stringEditor (\s -> not (null s)), + paraName <<<- ParaName "Executable Name" + $ emptyParams) + (stringEditor (\s -> not (null s)), + paraDirection <<<- ParaDirection Vertical + $ paraName <<<- ParaName "File with main function" + $ emptyParams) + (buildInfoEditorP countBuildInfo, paraName <<<- ParaName "Build Info" + $ paraOuterAlignment <<<- ParaOuterAlignment (0.0, 0.0, 0.0, 0.0) + $ paraOuterPadding <<<- ParaOuterPadding (0, 0, 0, 0) + $ paraInnerAlignment <<<- ParaInnerAlignment (0.0, 0.0, 0.0, 0.0) + $ paraInnerPadding <<<- ParaInnerPadding (0, 0, 0, 0) + $ emptyParams) + (paraDirection <<<- ParaDirection Vertical $ para) + noti + let pinj (Executable' s f bi) = inj (s,f,bi) + let pext = do + mbp <- ext + case mbp of + Nothing -> return Nothing + Just (s,f,bi) -> return (Just $Executable' s f bi) + return (wid,pinj,pext) + +buildInfoEditorP :: Int -> Editor Int +buildInfoEditorP numberOfBuildInfos para noti = do + (wid,inj,ext) <- intEditor (1.0,fromIntegral numberOfBuildInfos,1.0) + (paraName <<<- ParaName "Build Info" $para) noti + let pinj i = inj (i + 1) + let pext = do + mbV <- ext + case mbV of + Nothing -> return Nothing + Just i -> return (Just (i - 1)) + return (wid,pinj,pext) + +-- ------------------------------------------------------------ +-- * (Boring) default values +-- ------------------------------------------------------------ + + +instance Default CompilerFlavor + where getDefault = GHC + +instance Default BuildInfo + where getDefault = emptyBuildInfo + +instance Default Library + where getDefault = Library [] getDefault getDefault + +instance Default Executable + where getDefault = Executable getDefault getDefault getDefault + +instance Default RepoType + where getDefault = Darcs + +instance Default RepoKind + where getDefault = RepoThis + +instance Default SourceRepo + where getDefault = SourceRepo getDefault getDefault getDefault getDefault getDefault + getDefault getDefault + +instance Default BuildType + where getDefault = Simple + diff --git a/src/IDE/Pane/Preferences.hs b/src/IDE/Pane/Preferences.hs --- a/src/IDE/Pane/Preferences.hs +++ b/src/IDE/Pane/Preferences.hs @@ -47,7 +47,6 @@ import IDE.PrinterParser hiding (fieldParser,parameters) import IDE.Pane.SourceBuffer import IDE.Pane.Log -import IDE.SpecialEditors import Default import IDE.FileUtils import System.IO @@ -377,38 +376,40 @@ (filesEditor Nothing FileChooserActionSelectFolder "Select folder") (\i -> return ()) , mkFieldPP - (paraName <<<- ParaName - "Packages which are excluded from the modules pane" $ emptyParams) + (paraName <<<- ParaName "Extract packages from cabal-install" $ emptyParams) (PP.text . show) readParser - packageBlacklist - (\b a -> a{packageBlacklist = b}) - (dependenciesEditor packages) + autoExtractTars + (\b a -> a{autoExtractTars = b}) + (maybeEditor ((fileEditor (Just "~/.cabal/packages/") FileChooserActionSelectFolder + "Select folder"), emptyParams) True "Yes") (\i -> return ()) , mkFieldPP - (paraName <<<- ParaName "Update metadata after every build" $ emptyParams) + (paraName <<<- ParaName "Update metadata at startup" $ emptyParams) (PP.text . show) boolParser - collectAfterBuild - (\b a -> a{collectAfterBuild = b}) + collectAtStart + (\b a -> a{collectAtStart = b}) boolEditor (\i -> return ()) , mkFieldPP - (paraName <<<- ParaName "Update metadata at startup" $ emptyParams) + (paraName <<<- ParaName "Update metadata after every build" $ emptyParams) (PP.text . show) boolParser - collectAtStart - (\b a -> a{collectAtStart = b}) + collectAfterBuild + (\b a -> a{collectAfterBuild = b}) boolEditor (\i -> return ()) - , mkFieldPP - (paraName <<<- ParaName "Extract packages from cabal-install" $ emptyParams) + ]), + ("Blacklist", VFDPP emptyParams [ + mkFieldPP + (paraName <<<- ParaName + "Packages which are excluded from the modules pane" $ emptyParams) (PP.text . show) readParser - autoExtractTars - (\b a -> a{autoExtractTars = b}) - (maybeEditor ((fileEditor (Just "~/.cabal/packages/") FileChooserActionSelectFolder - "Select folder"), emptyParams) True "Yes") + packageBlacklist + (\b a -> a{packageBlacklist = b}) + (dependenciesEditor packages) (\i -> return ()) ]), ("Build", VFDPP emptyParams [ @@ -443,6 +444,18 @@ (stringEditor (\s -> not (null s))) (\i -> return ()) ])] + + +styleEditor :: Editor (Maybe String) +styleEditor p n = do + styleManager <- sourceStyleSchemeManagerNew + ids <- sourceStyleSchemeManagerGetSchemeIds styleManager + maybeEditor (comboSelectionEditor ids id, p) True "Select a special style?" p n + +panePathEditor :: Editor StandardPath +panePathEditor = genericEditor + + instance Default PackageIdentifier where getDefault = case toPackageIdentifier "unknown-0" of diff --git a/src/IDE/Pane/References.hs b/src/IDE/Pane/References.hs --- a/src/IDE/Pane/References.hs +++ b/src/IDE/Pane/References.hs @@ -95,8 +95,15 @@ mbAccessibleInfo <- readIDE accessibleInfo packages <- case scope of System -> case mbAccessibleInfo of - Nothing -> return [] - Just scope -> return ((Map.elems . fst) scope) + Nothing -> case mbCurrentInfo of + Nothing -> return [] + Just currentInfo -> return + ((Map.elems . fst . fst) currentInfo) + Just scope -> case mbCurrentInfo of + Nothing -> return ((Map.elems . fst) scope) + Just currentInfo -> return + ((Map.elems . fst . fst) currentInfo + ++ (Map.elems . fst) scope) Package -> case mbCurrentInfo of Nothing -> return [] Just currentInfo -> return ((Map.elems . fst . fst) currentInfo diff --git a/src/IDE/Pane/SourceBuffer.hs b/src/IDE/Pane/SourceBuffer.hs --- a/src/IDE/Pane/SourceBuffer.hs +++ b/src/IDE/Pane/SourceBuffer.hs @@ -68,6 +68,8 @@ import Graphics.UI.Gtk hiding (afterToggleOverwrite) import Graphics.UI.Gtk.SourceView import Graphics.UI.Gtk.Multiline.TextView +import Graphics.UI.Gtk.General.Enums (Click(..)) +import Graphics.UI.Gtk.Gdk.Events (eventClick) import Control.Monad.Reader --import Data.IORef import System.IO @@ -397,7 +399,32 @@ ) sv `onMoveCursor` (\step n select -> do reflectIDE Completion.cancel ideR) - sv `onButtonPress` (\event -> do reflectIDE Completion.cancel ideR; return False) + sv `onButtonPress` + \event -> do + let click = eventClick event + liftIO $ do + reflectIDE Completion.cancel ideR + case click of + DoubleClick -> do + let isSelectChar a = (isAlphaNum a) || (a == '_') + (start, end) <- textBufferGetSelectionBounds buffer + mbStartChar <- textIterGetChar start + mbEndChar <- textIterGetChar end + case mbStartChar of + Just startChar | isSelectChar startChar -> do + found <- textIterBackwardFindChar start (not.isSelectChar) Nothing + when found $ do + textIterForwardChar start + return () + _ -> return () + case mbEndChar of + Just endChar | isSelectChar endChar -> do + textIterForwardFindChar end (not.isSelectChar) Nothing + return () + _ -> return () + textBufferSelectRange buffer start end + return True + _ -> return False return (buf,[cid]) addPaneAdmin buf (map ConnectC cids) panePath liftIO $do diff --git a/src/IDE/SpecialEditors.hs b/src/IDE/SpecialEditors.hs deleted file mode 100644 --- a/src/IDE/SpecialEditors.hs +++ /dev/null @@ -1,431 +0,0 @@ --- --- | Special Editors --- - -module IDE.SpecialEditors ( - packageEditor -, testedWidthEditor -, compilerFlavorEditor -, versionRangeEditor -, versionEditor -, dependencyEditor -, dependenciesEditor -, filesEditor -, stringsEditor -, extensionsEditor -, panePathEditor -, libraryEditor -, executablesEditor -, modulesEditor -, styleEditor -, Library'(..) -, Executable'(..) -) where - -import Graphics.UI.Editor.Simple (intEditor,genericEditor,staticListEditor,comboSelectionEditor,stringEditor,fileEditor) -import Graphics.UI.Gtk -import Graphics.UI.Gtk.SourceView (sourceStyleSchemeManagerGetSchemeIds) -import Graphics.UI.Gtk.SourceView (sourceStyleSchemeManagerNew) -import Distribution.ModuleName (ModuleName(..)) -import Data.List (sort) -import Distribution.Text (simpleParse,display) -import Control.Monad.Reader -import Distribution.PackageDescription -import Distribution.Package -import Distribution.Compiler -import Distribution.Version -import Language.Haskell.Extension - -import IDE.Core.State hiding (packageId) -import Graphics.UI.Editor.Basics -import Graphics.UI.Editor.Composite -import Graphics.UI.Editor.Parameters -import Default -import MyMissing - -packageEditor :: Editor PackageIdentifier -packageEditor para noti = do - (wid,inj,ext) <- pairEditor - (stringEditor (\s -> not (null s)), paraName <<<- ParaName "Name" $ emptyParams) - (versionEditor, paraName <<<- ParaName "Version" $ emptyParams) - (paraDirection <<<- ParaDirection Horizontal - $ paraShadow <<<- ParaShadow ShadowIn - $ para) noti - let pinj (PackageIdentifier (PackageName n) v) = inj (n,v) - let pext = do - mbp <- ext - case mbp of - Nothing -> return Nothing - Just (n,v) -> do - if null n - then return Nothing - else return (Just $PackageIdentifier (PackageName n) v) - return (wid,pinj,pext) - -testedWidthEditor :: Editor [(CompilerFlavor, VersionRange)] -testedWidthEditor para = do - multisetEditor - (ColumnDescr True [("Compiler Flavor",\(cv,_) -> [cellText := show cv]) - ,("Version Range",\(_,vr) -> [cellText := display vr])]) - (pairEditor - (compilerFlavorEditor, paraShadow <<<- (ParaShadow ShadowNone) $ emptyParams) - (versionRangeEditor, paraShadow <<<- (ParaShadow ShadowNone) $ emptyParams), - (paraDirection <<<- (ParaDirection Vertical) $ emptyParams)) - para - -compilerFlavorEditor :: Editor CompilerFlavor -compilerFlavorEditor para noti = do - noti2 <- emptyNotifier - noti3 <- emptyNotifier - (wid,inj,ext) <- eitherOrEditor - (comboSelectionEditor flavors , paraName <<<- (ParaName "Select compiler") $ emptyParams) - (stringEditor (\s -> not (null s)), paraName <<<- (ParaName "Specify compiler") $ emptyParams) - "Other" - (paraName <<<- ParaName "Select" $ para) - noti - let cfinj comp = case comp of - (OtherCompiler str) -> inj (Right "") - other -> inj (Left other) - let cfext = do - mbp <- ext - case mbp of - Nothing -> return Nothing - Just (Right s) -> return (Just $OtherCompiler s) - Just (Left other) -> return (Just other) - return (wid,cfinj,cfext) - where - flavors = [GHC, NHC, Hugs, HBC, Helium, JHC] - -versionRangeEditor :: Editor VersionRange -versionRangeEditor para noti = do - (wid,inj,ext) <- - maybeEditor - (eitherOrEditor - (pairEditor - (comboSelectionEditor v1, emptyParams) - (versionEditor, paraName <<<- ParaName "Enter Version" $ emptyParams), - (paraDirection <<<- ParaDirection Vertical) - $ paraOuterAlignment <<<- ParaOuterAlignment (0.0, 0.0, 0.0, 0.0) - $ paraOuterPadding <<<- ParaOuterPadding (0, 0, 0, 0) - $ paraInnerAlignment <<<- ParaInnerAlignment (0.0, 0.0, 0.0, 0.0) - $ paraInnerPadding <<<- ParaInnerPadding (0, 0, 0, 0) - $ emptyParams) - (pairEditor - (comboSelectionEditor v2, emptyParams) - (pairEditor - (versionRangeEditor, paraShadow <<<- ParaShadow ShadowIn $ emptyParams) - (versionRangeEditor, paraShadow <<<- ParaShadow ShadowIn $ emptyParams), - paraDirection <<<- ParaDirection Vertical $ emptyParams), - paraDirection <<<- ParaDirection Vertical - $ paraOuterAlignment <<<- ParaOuterAlignment (0.0, 0.0, 0.0, 0.0) - $ paraOuterPadding <<<- ParaOuterPadding (0, 0, 0, 0) - $ paraInnerAlignment <<<- ParaInnerAlignment (0.0, 0.0, 0.0, 0.0) - $ paraInnerPadding <<<- ParaInnerPadding (0, 0, 0, 0) - $ emptyParams ) - "Complex",paraName <<<- ParaName "Simple" - $ paraOuterAlignment <<<- ParaOuterAlignment (0.0, 0.0, 0.0, 0.0) - $ paraOuterPadding <<<- ParaOuterPadding (0, 0, 0, 0) - $ paraInnerAlignment <<<- ParaInnerAlignment (0.0, 0.0, 0.0, 0.0) - $ paraInnerPadding <<<- ParaInnerPadding (0, 0, 0, 0) - $ emptyParams) False "Any Version" - (paraDirection <<<- ParaDirection Vertical $ para) - noti - let vrinj AnyVersion = inj Nothing - vrinj (ThisVersion v) = inj (Just (Left (ThisVersionS,v))) - vrinj (LaterVersion v) = inj (Just (Left (LaterVersionS,v))) - vrinj (EarlierVersion v) = inj (Just (Left (EarlierVersionS,v))) - vrinj (UnionVersionRanges (ThisVersion v1) (LaterVersion v2)) | v1 == v2 - = inj (Just (Left (ThisOrLaterVersionS,v1))) - vrinj (UnionVersionRanges (LaterVersion v1) (ThisVersion v2)) | v1 == v2 - = inj (Just (Left (ThisOrLaterVersionS,v1))) - vrinj (UnionVersionRanges (ThisVersion v1) (EarlierVersion v2)) | v1 == v2 - = inj (Just (Left (ThisOrEarlierVersionS,v1))) - vrinj (UnionVersionRanges (EarlierVersion v1) (ThisVersion v2)) | v1 == v2 - = inj (Just (Left (ThisOrEarlierVersionS,v1))) - vrinj (UnionVersionRanges v1 v2)= inj (Just (Right (UnionVersionRangesS,(v1,v2)))) - vrinj (IntersectVersionRanges v1 v2) - = inj (Just (Right (IntersectVersionRangesS,(v1,v2)))) - let vrext = do mvr <- ext - case mvr of - Nothing -> return (Just AnyVersion) - Just Nothing -> return (Just AnyVersion) - Just (Just (Left (ThisVersionS,v))) -> return (Just (ThisVersion v)) - Just (Just (Left (LaterVersionS,v))) -> return (Just (LaterVersion v)) - Just (Just (Left (EarlierVersionS,v))) -> return (Just (EarlierVersion v)) - - Just (Just (Left (ThisOrLaterVersionS,v))) -> return (Just (orLaterVersion v)) - Just (Just (Left (ThisOrEarlierVersionS,v))) -> return (Just (orEarlierVersion v)) - Just (Just (Right (UnionVersionRangesS,(v1,v2)))) - -> return (Just (UnionVersionRanges v1 v2)) - Just (Just (Right (IntersectVersionRangesS,(v1,v2)))) - -> return (Just (IntersectVersionRanges v1 v2)) - return (wid,vrinj,vrext) - where - v1 = [ThisVersionS,LaterVersionS,ThisOrLaterVersionS,EarlierVersionS,ThisOrEarlierVersionS] - v2 = [UnionVersionRangesS,IntersectVersionRangesS] - -data Version1 = ThisVersionS | LaterVersionS | ThisOrLaterVersionS | EarlierVersionS | ThisOrEarlierVersionS - deriving (Eq) -instance Show Version1 where - show ThisVersionS = "This Version" - show LaterVersionS = "Later Version" - show ThisOrLaterVersionS = "This or later Version" - show EarlierVersionS = "Earlier Version" - show ThisOrEarlierVersionS = "This or earlier Version" - -data Version2 = UnionVersionRangesS | IntersectVersionRangesS - deriving (Eq) -instance Show Version2 where - show UnionVersionRangesS = "Union Version Ranges" - show IntersectVersionRangesS = "Intersect Version Ranges" - -versionEditor :: Editor Version -versionEditor para noti = do - (wid,inj,ext) <- stringEditor (\s -> not (null s)) para noti - let pinj v = inj (display v) - let pext = do - s <- ext - case s of - Nothing -> return Nothing - Just s -> return (simpleParse s) - return (wid, pinj, pext) - -dependencyEditor :: [PackageIdentifier] -> Editor Dependency -dependencyEditor packages para noti = do - (wid,inj,ext) <- pairEditor - (comboSelectionEditor (sort (map (display . pkgName) packages)) - , paraName <<<- ParaName "Package Name" $ emptyParams) - (versionRangeEditor,paraName <<<- ParaName "Version" $ emptyParams) - (paraDirection <<<- ParaDirection Vertical $ para) - noti - let pinj (Dependency (PackageName s) v) = inj (s,v) - let pext = do - mbp <- ext - case mbp of - Nothing -> return Nothing - Just ("",v) -> return Nothing - Just (s,v) -> return (Just $Dependency (PackageName s) v) - return (wid,pinj,pext) - -dependenciesEditor :: [PackageIdentifier] -> Editor [Dependency] -dependenciesEditor packages p noti = - multisetEditor - (ColumnDescr True [("Package",\(Dependency (PackageName str) _) -> [cellText := str]) - ,("Version",\(Dependency _ vers) -> [cellText := display vers])]) - (dependencyEditor packages, - paraOuterAlignment <<<- ParaInnerAlignment (0.0, 0.5, 1.0, 1.0) - $ paraInnerAlignment <<<- ParaOuterAlignment (0.0, 0.5, 1.0, 1.0) - $ emptyParams) - (paraShadow <<<- ParaShadow ShadowIn $ - paraOuterAlignment <<<- ParaInnerAlignment (0.0, 0.5, 1.0, 1.0) - $ paraInnerAlignment <<<- ParaOuterAlignment (0.0, 0.5, 1.0, 1.0) - $ paraDirection <<<- ParaDirection Vertical - $ paraPack <<<- ParaPack PackGrow - $ p) - noti - -filesEditor :: Maybe FilePath -> FileChooserAction -> String -> Editor [FilePath] -filesEditor fp act label p = - multisetEditor - (ColumnDescr False [("",(\row -> [cellText := row]))]) - (fileEditor fp act label, emptyParams) - (paraShadow <<<- ParaShadow ShadowIn $ - paraDirection <<<- ParaDirection Vertical $ p) - -stringsEditor :: (String -> Bool) -> Editor [String] -stringsEditor validation p = - multisetEditor - (ColumnDescr False [("",(\row -> [cellText := row]))]) - (stringEditor validation, emptyParams) - (paraShadow <<<- ParaShadow ShadowIn $ p) - -panePathEditor :: Editor StandardPath -panePathEditor = genericEditor - -extensionsEditor :: Editor [Extension] -extensionsEditor p = staticListEditor extensionsL (paraMultiSel <<<- ParaMultiSel True $ p) - -styleEditor :: Editor (Maybe String) -styleEditor p n = do - styleManager <- sourceStyleSchemeManagerNew - ids <- sourceStyleSchemeManagerGetSchemeIds styleManager - maybeEditor (comboSelectionEditor ids, p) True "Select a special style?" p n - - -extensionsL :: [Extension] -extensionsL = knownExtensions - -{--[ - OverlappingInstances - , UndecidableInstances - , IncoherentInstances - , RecursiveDo - , ParallelListComp - , MultiParamTypeClasses - , NoMonomorphismRestriction - , FunctionalDependencies - , Rank2Types - , RankNTypes - , PolymorphicComponents - , ExistentialQuantification - , ScopedTypeVariables - , ImplicitParams - , FlexibleContexts - , FlexibleInstances - , EmptyDataDecls - , CPP - , BangPatterns - , TypeSynonymInstances - , TemplateHaskell - , ForeignFunctionInterface - , Arrows - , Generics - , NoImplicitPrelude - , NamedFieldPuns - , PatternGuards - , GeneralizedNewtypeDeriving - , ExtensibleRecords - , RestrictedTypeSynonyms - , HereDocuments]--} - --- ------------------------------------------------------------ --- * BuildInfos --- ------------------------------------------------------------ - -data Library' = Library'{ - exposedModules' :: [ModuleName] -, libExposed' :: Bool -, libBuildInfoIdx :: Int} - deriving (Show, Eq) - -data Executable' = Executable'{ - exeName' :: String -, modulePath' :: FilePath -, buildInfoIdx :: Int} - deriving (Show, Eq) - -instance Default Library' - where getDefault = Library' [] getDefault getDefault - -instance Default Executable' - where getDefault = Executable' getDefault getDefault getDefault - - -libraryEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor Library' -libraryEditor fp modules numBuildInfos para noti = do - (wid,inj,ext) <- - pairEditor - (modulesEditor modules, - paraName <<<- ParaName "Exposed Modules" - $ paraPack <<<- ParaPack PackGrow - $ paraMinSize <<<- ParaMinSize (-1,500) - $ para) - (buildInfoEditorP numBuildInfos, paraName <<<- ParaName "Build Info" - $ paraPack <<<- ParaPack PackNatural - $ para) - (paraDirection <<<- ParaDirection Vertical - $ paraPack <<<- ParaPack PackGrow - $ emptyParams) - noti - let pinj (Library' em True bi) = inj (map display em,bi) - pinj _ = throwIDE "SpecialEditors>>libraryEditor: No Library" - let pext = do - mbp <- ext - case mbp of - Nothing -> return Nothing - Just (em,bi) -> return (Just $Library' (map (\s -> forceJust (simpleParse s) - "SpecialEditor >> libraryEditor: no parse for moduile name") em) True bi) - return (wid,pinj,pext) - -moduleEditor :: [ModuleName] -> Editor String -moduleEditor modules = comboSelectionEditor (map display modules) - -modulesEditor :: [ModuleName] -> Editor [String] -modulesEditor modules = staticListEditor (map display modules) - -executablesEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor [Executable'] -executablesEditor fp modules countBuildInfo p = - multisetEditor - (ColumnDescr True [("Executable Name",\(Executable' exeName _ _) -> [cellText := exeName]) - ,("Module Path",\(Executable' _ mp _) -> [cellText := mp]) - - ,("Build info index",\(Executable' _ _ bii) -> [cellText := show (bii + 1)])]) - (executableEditor fp modules countBuildInfo,emptyParams) - (paraShadow <<<- ParaShadow ShadowIn $ p) - -executableEditor :: Maybe FilePath -> [ModuleName] -> Int -> Editor Executable' -executableEditor fp modules countBuildInfo para noti = do - (wid,inj,ext) <- pairEditor - (pairEditor - (stringEditor (\s -> not (null s)), - paraName <<<- ParaName "Executable Name" - $ emptyParams) - (stringEditor (\s -> not (null s)), - paraDirection <<<- ParaDirection Vertical - $ paraName <<<- ParaName "File with main function" - $ emptyParams), para) - (buildInfoEditorP countBuildInfo, paraName <<<- ParaName "Build Info" - $ paraOuterAlignment <<<- ParaOuterAlignment (0.0, 0.0, 0.0, 0.0) - $ paraOuterPadding <<<- ParaOuterPadding (0, 0, 0, 0) - $ paraInnerAlignment <<<- ParaInnerAlignment (0.0, 0.0, 0.0, 0.0) - $ paraInnerPadding <<<- ParaInnerPadding (0, 0, 0, 0) - $ emptyParams) - (paraDirection <<<- ParaDirection Vertical $ para) - noti - let pinj (Executable' s f bi) = inj ((s,f),bi) - let pext = do - mbp <- ext - case mbp of - Nothing -> return Nothing - Just ((s,f),bi) -> return (Just $Executable' s f bi) - return (wid,pinj,pext) - -buildInfoEditorP :: Int -> Editor Int -buildInfoEditorP numberOfBuildInfos para noti = do - (wid,inj,ext) <- intEditor (1.0,fromIntegral numberOfBuildInfos,1.0) - (paraName <<<- ParaName "Build Info" $para) noti - let pinj i = inj (i + 1) - let pext = do - mbV <- ext - case mbV of - Nothing -> return Nothing - Just i -> return (Just (i - 1)) - return (wid,pinj,pext) - --- ------------------------------------------------------------ --- * (Boring) default values --- ------------------------------------------------------------ - -instance Default Version1 - where getDefault = ThisVersionS - -instance Default Version2 - where getDefault = UnionVersionRangesS - -instance Default Version - where getDefault = forceJust (simpleParse "0") "SpecialEditors>>default version" - -instance Default VersionRange - where getDefault = AnyVersion - -instance Default CompilerFlavor - where getDefault = GHC - -instance Default BuildInfo - where getDefault = emptyBuildInfo - -instance Default Library - where getDefault = Library [] getDefault getDefault - -instance Default Dependency - where getDefault = Dependency getDefault getDefault - -instance Default Executable - where getDefault = Executable getDefault getDefault getDefault - -instance Default PackageName - where getDefault = PackageName getDefault - - - -