GuiHaskell (empty) → 0.1
raw patch · 13 files changed
+1948/−0 lines, 13 filesdep +basedep +filepathdep +gladebuild-type:Customsetup-changed
Dependencies added: base, filepath, glade, gtk, parsec, proplang
Files
- Config.hs +87/−0
- Data.hs +227/−0
- Evaluator.hs +158/−0
- GuiHaskell.cabal +21/−0
- LICENSE +27/−0
- Main.hs +295/−0
- Prof.hs +166/−0
- Setup.lhs +3/−0
- Text/EscapeCodes.hs +69/−0
- Util.hs +15/−0
- res/about.glade +39/−0
- res/guihaskell.glade +524/−0
- res/prefdialog.glade +317/−0
+ Config.hs view
@@ -0,0 +1,87 @@+-----------------------------------------------------------------------------+-- +-- Module : Config.hs+-- Copyright : (c) Asumu Takikawa 2007+-- License : +--+-- Maintainer : +-- Stability : unstable+-- Portability : not portable, PropLang+--+-- GuiHaskell configuration API+--+-- GuiHaskell stores each configuration value in a+-- separate file inside of a configuration directory+-- (e.g. ~/.guihaskell/config)+--+-----------------------------------------------------------------------------++module Config (+ confInit, newConfValueWithDefault+ ) where++import Control.Monad+import System.Directory+import System.FilePath+import System.IO+import System.IO.Error++import PropLang.Event+import PropLang.Value++--+-- Make sure we can do config stuff+--+confInit :: IO ()+confInit = do+ d <- getConfigDir+ createDirectoryIfMissing True d++--+-- A value constructor that reads and writes using a+-- set of config files+--+--newConfValue :: (Eq a, Show a, Read a) => String -> Event -> IO (Value a)+--newConfValue = newConfValueWithDefault ""++--+-- Config constructor that takes a default value+--+newConfValueWithDefault + :: (Eq a, Show a, Read a) => a -> String -> Event -> IO (Value a)+newConfValueWithDefault def name ev = do+ cf <- confFile+ exists <- doesFileExist cf+ if exists then do return ()+ else do openFile cf WriteMode >>= hClose -- touch+ return $ Value (setter) (getter)+ where+ setter x = do+ cf <- confFile+ old <- getter+ h <- openFile cf WriteMode+ hPutStr h $ show x+ hClose h+ if old /= x then do raise ev+ else do return ()++ getter = do+ cf <- confFile+ h <- openFile cf ReadMode+ val <- catch (readIO =<< hGetLine h)+ (\e -> if isEOFError e + then return def + else ioError e)+ hClose h+ return val++ confFile = do d <- getConfigDir; return $ d </> name++-- +-- The directory where config files reside+-- Might need special case for Windows?+--+getConfigDir :: IO FilePath+getConfigDir = do+ d <- getHomeDirectory+ return $ d </> ".guihaskell" </> "config"
+ Data.hs view
@@ -0,0 +1,227 @@+----------------------------------------------------------------------------- +-- +-- Module : Data.hs +-- Copyright : (c) Neil Mitchell 2007 +-- License : +-- +-- Maintainer : +-- Stability : unstable +-- Portability : not portable, uses Gtk2Hs +-- +-- Defines the core data structures for GuiHaskell. +-- +-- Data passes around some global state. Data includes +-- EvalState, which holds the states of the individual +-- compilers that GuiHaskell can run. +-- +----------------------------------------------------------------------------- + +module Data ( + Data(..), Evaluator(..), Handles(..), + empty, getHandles, setHandles, setCurrentFile, + setupFonts, appendText, appendRed, applyEscape, + promptCmd + ) where + +import PropLang.Gtk +import PropLang.Variable + +import Data.Map (Map) +import qualified Data.Map as M + +import Control.Concurrent (ThreadId) +import System.IO (Handle) +import System.Process (ProcessHandle) +import Text.EscapeCodes + +import Control.Monad +import Numeric + +import Graphics.UI.Gtk hiding (Action, Window, ComboBox, MenuItem, TextView, ToolButton, FontButton, Event, onClicked, onChanged) + + +data Data = Data { + -- Main Window and friends + window :: Window + , txtOut :: TextView + , txtIn :: TextView + , txtSelect :: TextEntry + , sb :: StatusBar + + , tbRun :: ToolButton + , tbStop :: ToolButton + , tbRestart :: ToolButton + , tbOpen :: ToolButton + , tbRecent :: ToolButton + , tbProfile :: ToolButton + , tbPref :: ToolButton + + , cbCompiler :: ComboBox + + , fbFont :: FontButton + + , miFile :: MenuItem + , miOpen :: MenuItem + , miQuit :: MenuItem + , miEdit :: MenuItem + , miCut :: MenuItem + , miCopy :: MenuItem + , miPaste :: MenuItem + , miView :: MenuItem + , miTools :: MenuItem + , miRun :: MenuItem + , miProfile :: MenuItem + , miPref :: MenuItem + , miHelp :: MenuItem + , miAbout :: MenuItem + + -- Preferences Dialog and friends + , wndPref :: Window + , txtExecutable :: TextEntry + , txtProfCFlags :: TextEntry + , txtProfRFlags :: TextEntry + , tbClose :: ToolButton + + -- About dialog + , wndAbout :: Window + + , running :: Var Bool -- is the code executing + , filename :: Var (Maybe FilePath) -- the main file loaded + , outputTags :: Var [String] + , history :: Var ([String], [String]) -- command history + + -- Configuration variables + , profCFlags :: Var String + , profRFlags :: Var String + , executable :: Var FilePath + , font :: Var String + + -- + -- Stores the current evaluator and + -- the states of background evaluators + -- + -- When a new evaluator is chosen, the + -- current evaluator is swapped into the list + -- and the new evalutor is put into current + , current :: Var Evaluator + , states :: Var (Map Evaluator Handles) + } + +-- +-- A data structure for storing the compiler-specific +-- details +-- +data Handles = Handles { + handle :: Handle, + process :: ProcessHandle, + outId :: ThreadId, + errId :: ThreadId + } + +-- hack! +-- shouldn't matter as long as you use Var like an IORef +-- maybe ProcessHandle should instantiate Eq +instance Eq Handles where + _ == _ = True + +data Evaluator = Hugs | GHCi deriving (Show, Read, Eq, Ord) + + +-- So Main doesn't need to import Map +empty :: Map Evaluator Handles +empty = M.empty + +-- Probably belongs in Evaluator.hs +promptCmd :: Evaluator -> String -> String +promptCmd Hugs xs = ":set -p\"" ++ xs ++ "\"" +promptCmd GHCi xs = ":set prompt " ++ xs + +-- Get the current evaluator +getHandles :: Data -> IO (Maybe Handles) +getHandles dat = do + c <- getVar $ current dat + s <- getVar $ states dat + return $ M.lookup c s + +-- Set the handles for the current evaluator +setHandles :: Data -> Maybe Handles -> IO () +setHandles dat hndls = do + c <- getVar $ current dat + s <- getVar $ states dat + case hndls of + Nothing -> states dat -< M.delete c s + Just x -> + case M.lookup c s of + Nothing -> states dat -< M.insert c x s + Just _ -> states dat -< M.adjust (\_ -> x) c s + +-- Set the currently open file +setCurrentFile :: Data -> Maybe FilePath -> IO () +setCurrentFile dat path = do + filename dat -< path + +-- +-- +-- +setupFonts :: Data -> IO () +setupFonts dat@Data{txtOut=out,txtIn=inp} = do + buf <- textviewBuffer out + tags <- textBufferGetTagTable buf + fontStr <- getVar $ (fbFont dat)!text + + mapM (addTags tags) [minBound..maxBound] + + fdesc <- fontDescriptionFromString fontStr + + widgetModifyFont (getTextViewRaw out) (Just fdesc) + widgetModifyFont (getTextViewRaw inp) (Just fdesc) + + where + addTags tags col = do + let name = show col + (r,g,b) = getColor col + f x = let xs = showHex x "" in ['0' | length xs == 1] ++ xs + css = "#" ++ f r ++ f g ++ f b + + tagFg <- textTagNew (Just $ "fg" ++ name) + tagBg <- textTagNew (Just $ "bg" ++ name) + textTagTableAdd tags tagFg + textTagTableAdd tags tagBg + set tagFg [textTagForeground := css] + set tagBg [textTagBackground := css] + +-- +-- Append text to output area +-- +appendText :: Data -> String -> IO () +appendText dat@Data{txtOut=out} s = do + buf <- textviewBuffer out + end <- textBufferGetEndIter buf + textBufferInsert buf end s + + len <- textBufferGetCharCount buf + strt <- textBufferGetIterAtOffset buf (len - length s) + end2 <- textBufferGetEndIter buf + tags <- getVar (outputTags dat) + mapM_ (f buf strt end2) tags + where + f buf strt end tag = textBufferApplyTagByName buf tag strt end + + +appendRed :: Data -> String -> IO () +appendRed dat msg = do + let tags = outputTags dat + res <- getVar tags + tags -< ["fgRed"] + appendText dat msg + tags -< res + + +applyEscape :: Data -> EscapeCode -> IO () +applyEscape dat (FormatAttribute Normal) = outputTags dat -< [] +applyEscape dat (FormatForeground Green) = outputTags dat -< ["fgGreen"] +applyEscape _ _ = return () + + +--when_ :: Monad m => Bool -> m () -> m () +--when_ b x = when b (x >> return ())
+ Evaluator.hs view
@@ -0,0 +1,158 @@+----------------------------------------------------------------------------- +-- +-- Module : Evaluator.hs +-- Copyright : (c) Neil Mitchell 2007 +-- License : +-- +-- Maintainer : +-- Stability : unstable +-- Portability : not portable, uses Gtk2Hs +-- +-- Evaluator functions. +-- +----------------------------------------------------------------------------- + +module Evaluator ( + switchEvaluator, startEvaluator, stopEvaluator, + startWithFile, runExternal + ) where + +import Control.Concurrent +import Data.Char +import System.Directory +import System.IO +import System.Process + +import PropLang.Variable + +import Data +import Text.EscapeCodes +import Util + + +prompt :: String +prompt = "\x1B[0;32m%s>\x1B[0m \x1B[50m" + +-- +-- Switch the currently running evaluator +-- +switchEvaluator :: Data -> IO () +switchEvaluator dat = do + hndl <- getHandles dat + case hndl of + Nothing -> do + startEvaluator dat Nothing + Just (Handles inp _ _ _) -> do + appendText dat "\nSwitching...\n" + putStrLn "Switching evaluators" + hPutStrLn inp $ "" + +-- +-- Start an evaluator +-- +startEvaluator :: Data -> Maybe [String] -> IO () +startEvaluator dat args = do + name <- getVar $ current dat + path <- getCompilerPath name + case path of + Nothing -> do + errorMessage dat $ show name ++ " not found, please install." + Just x -> do + runCompiler x + where + runCompiler path = do + name <- getVar $ current dat + (inp,out,err,pid) <- runExternal path args + + appendText dat $ "\nLoading " ++ show name ++ "...\n" + hPutStrLn inp $ promptCmd name prompt + hPutStrLn inp $ "putChar '\\01'" + + oid <- forkIO (readOut name out) + eid <- forkIO (readErr name err) + + setHandles dat (Just $ Handles inp pid oid eid) + + readOut :: Evaluator -> Handle -> IO () + readOut Hugs hndl = do + c <- hGetContents hndl + let c2 = filter (/= '\r') $ tail $ dropWhile (/= '\01') c + mapM_ app $ parseEscapeCodes c2 + readOut GHCi hndl = do + c <- hGetContents hndl + let c2 = filter (/= '\r') $ tail $ dropWhile (/= '\01') c + mapM_ app $ parseEscapeCodes c2 + + readErr :: Evaluator -> Handle -> IO () + readErr Hugs _ = return () + readErr GHCi hndl = do + c <- hGetContents hndl + let c2 = filter (/= '\r') c + mapM_ (\x -> appendRed dat [x]) c2 + + app (Left c) = appendText dat [c] + app (Right (FormatUnknown 50)) = running dat -< False + app (Right e) = applyEscape dat e + + getCompilerPath c = do + case c of + Hugs -> getHugsPath + _ -> getOtherPath c + +-- +-- Useful wrapper around runInteractiveProcess +-- +runExternal :: FilePath -> Maybe [String] -> IO (Handle, Handle, Handle, ProcessHandle) +runExternal path args = do + hndls@(inp, out, err, _) <- runInteractiveProcess path + (maybe [] id args) + Nothing Nothing + putStrLn $ "Starting external tool: " ++ path + hSetBuffering out NoBuffering + hSetBuffering err NoBuffering + hSetBuffering inp NoBuffering + hSetBinaryMode out True + hSetBinaryMode err True + return hndls + +-- +-- Stop the currently running evaluator +-- +stopEvaluator :: Data -> IO () +stopEvaluator dat = do + hndls <- getHandles dat + case hndls of + Nothing -> return () + Just (Handles inp pid _ _) -> do + setHandles dat Nothing + hPutStrLn inp "\n:quit\n" + waitForProcess pid + return () + +-- +-- Run a compiler with a file +-- +startWithFile :: Data -> IO () +startWithFile dat = do + path <- getVar $ filename dat + case path of + Nothing -> + errorMessage dat "No file selected for evaluation." + Just p -> do + stopEvaluator dat + appendText dat "Evaluating file...\n" + startEvaluator dat $ Just [p] + +getHugsPath :: IO (Maybe FilePath) +getHugsPath = do + path <- findExecutable "hugs" + case path of + Just x -> return $ Just x + Nothing -> do + let guesses = ["c:\\Program Files\\WinHugs\\hugs.exe"] + res <- mapM doesFileExist guesses + let ans = map snd $ filter fst $ zip res guesses + return $ if null ans then Nothing else Just (head ans) + +getOtherPath :: Evaluator -> IO (Maybe FilePath) +getOtherPath = findExecutable . map toLower . show
+ GuiHaskell.cabal view
@@ -0,0 +1,21 @@+Name: GuiHaskell+Synopsis: A graphical REPL and development environment for Haskell+Description:+ GuiHaskell aims to be a cross-platform development environment+ for Haskell that is integrated with other popular Haskell tools.+ The program uses the PropLang GUI combinator library to declaratively+ define the relationships between UI elements and data.+Version: 0.1+License: BSD3+License-file: LICENSE+Author: Neil Mitchell, Asumu Takikawa+Stability: Alpha+Homepage: http://www-users.cs.york.ac.uk/~ndm/guihaskell/+Category: Development+Build-Depends: base>=2.0, filepath>=1.0, proplang>=0.1, gtk>=0.9.11, glade>=0.9.11, parsec+Data-files: res/guihaskell.glade res/prefdialog.glade res/about.glade++Executable: guihaskell+Main-is: Main.hs+Other-modules: Config Data Evaluator Prof Util Text.EscapeCodes+Ghc-options: -O2 -Wall
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) Neil Mitchell++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ Main.hs view
@@ -0,0 +1,295 @@+----------------------------------------------------------------------------- +-- +-- Module : Main.hs +-- Copyright : (c) Neil Mitchell 2007 +-- License : +-- +-- Maintainer : +-- Stability : unstable +-- Portability : not portable, uses Gtk2Hs +-- +----------------------------------------------------------------------------- + +module Main where + +import PropLang.Gtk +import PropLang.Variable +import PropLang.Value +import PropLang.Event + +import Control.Monad +import Data.Char +import Data.Maybe +import System.IO + +import Control.Concurrent + +import Graphics.UI.Gtk hiding (Action, Window, ComboBox, MenuItem, TextView, ToolButton, FontButton, Event, onClicked, onChanged) +import Graphics.UI.Gtk.Glade + +import System.Exit +import System.Posix.Signals +import System.Process + +import Config +import Data +import Evaluator +import Prof +import Util + +main :: IO () +main = do + initPropLang + confInit + window <- getWindow "res/guihaskell.glade" "wndMain" + prefWindow <- getWindow "res/prefdialog.glade" "wndPref" + aboutWindow <- getWindow "res/about.glade" "wndAbout" + running <- newVarName "evaluator_on_off" True + filename <- newVarWithName "selected_filename" + (newConfValueWithDefault Nothing "selected_filename") + tags <- newVar [] + history <- newVar ([], []) + + -- Configuration variables + profCFlags <- newVarWithName "profiler_cflags_conf" + (newConfValueWithDefault "-prof -auto-all" "profCFlags") + profRFlags <- newVarWithName "profiler_rflags_conf" + (newConfValueWithDefault "+RTS -p" "profRFlags") + executable <- newVarWithName "executable_name" + (newConfValueWithDefault "foobar.exe" "executable") + font <- newVarWithName "textview_font" + (newConfValueWithDefault "Monospace 12" "textview_font") + + -- Evaluator variables + current <- newVarWithName "current_evaluator" + (newConfValueWithDefault GHCi "current_evaluator") + states <- newVarName "evaluator_states" empty + + let f x = getCtrl window x + g x = getCtrl prefWindow x + dat = Data window + (f "txtOut") (f "txtIn") (f "txtSelect") (f "sb") + (f "tbRun") (f "tbStop") (f "tbRestart") + (f "tbOpen") (f "tbRecent") (f "tbProfile") (f "tbPref") + (f "cbCompiler") (f "fbFont") + (f "miFile") (f "miOpen") (f "miQuit") + (f "miEdit") (f "miCut") (f "miCopy") (f "miPaste") + (f "miView") + (f "miTools") (f "miRun") (f "miProfile") (f "miPref") + (f "midHelp") (f "miAbout") + prefWindow + (g "txtExecutable") (g "txtProfCFlags") (g "txtProfRFlags") + (g "tbClose") + aboutWindow + running filename tags history + profCFlags profRFlags executable font + current states + + startEvaluator dat Nothing + setupRelations dat + setupFonts dat + + showWindowMain window + +-- +-- Run an open file dialog and +-- return the selection +-- +runFileDialog :: IO (Maybe FilePath) +runFileDialog = do + dialog <- fileChooserDialogNew Nothing Nothing FileChooserActionOpen [("Okay", ResponseOk), ("Cancel", ResponseCancel)] + response <- dialogRun dialog + widgetHide dialog + handleResponse dialog response + where + handleResponse dialog response = + case response of + ResponseOk -> fileChooserGetFilename dialog + _ -> return Nothing + +-- +-- Defines the actions for GUI elements +-- +setupRelations :: Data -> IO () +setupRelations dat@Data + -- This is ugly, but at least it's readable + { window =window + , tbRun =tbRun + , tbStop =tbStop + , tbRestart =tbRestart + , tbOpen =tbOpen + , tbPref =tbPref + , tbProfile =tbProfile + , cbCompiler =cbCompiler + , fbFont =fbFont + , txtIn =txtIn + , txtSelect =txtSelect + , miFile =miFile + , miOpen =miOpen + , miQuit =miQuit + , miRun =miRun + , miProfile =miProfile + , miPref =miPref + , miHelp =miHelp + , miAbout =miAbout + , wndPref =wndPref + , txtExecutable =txtExecutable + , txtProfCFlags =txtProfCFlags + , txtProfRFlags =txtProfRFlags + , tbClose =tbClose + , wndAbout =wndAbout + , running =running + , filename =filename + , executable =executable + , profCFlags =profCFlags + , profRFlags =profRFlags + , font =font + , current =current + } = do + + -- Evaluator events + tbRun!onClicked += fireCommand dat + tbRestart!onClicked += refreshCommand dat + tbOpen!onClicked += (runFileDialog >>= setCurrentFile dat >> startWithFile dat) + tbStop!onClicked += stopCommand dat + onEnterKey txtIn $ fireCommand dat + + -- Evaluator selection + injectWith (cbCompiler!text) current show + current =< with1 (cbCompiler!text) (\x -> if null x then Hugs else read x) + current += switchEvaluator dat + + -- Filename selection + injectWith (txtSelect!text) filename (maybe "" id) + tie (txtSelect!text) filename + (\t -> if null t then Nothing else Just t) (maybe "" id) + + -- Evaluator runtime status + tbRun!enabled =< with1 running not + tbStop!enabled =<= running + + -- Tools + tbProfile!onClicked += runProf dat + + -- Config Events + tbPref!onClicked += showWindow wndPref + miPref!onActivated += showWindow wndPref + -- Hack + tbClose!onClicked += closeWindow wndPref + fbFont!text -<- font + fbFont!text =<>= font + fbFont!text += setupFonts dat + + -- Need "-<-" first to populate GUI at startup + -- Then tie them + txtExecutable!text -<- executable + txtExecutable!text =<>= executable + txtProfCFlags!text -<- profCFlags + txtProfCFlags!text =<>= profCFlags + txtProfRFlags!text -<- profRFlags + txtProfRFlags!text =<>= profRFlags + + -- Key Events + -- Fixed some of the key event bugs. This should work. + -- The enter key still doesn't work though... + --enterKey <- newVarWithName "enter_key_pressed?" + -- (newPredValue "" ((==) "Return")) + --enterKey =<= (txtIn!key) + --enterKey += (fireCommand dat) + upKey <- newVarWithName "arrow_up_pressed?" + (newPredValue "" ((==) "Up")) + upKey =<= (txtIn!key) + upKey += (nextHistory dat) + downKey <- newVarWithName "arrow_down_pressed?" + (newPredValue "" ((==) "Down")) + downKey =<= (txtIn!key) + downKey += (previousHistory dat) + + -- Menus + miOpen!onActivated += (raise $ tbOpen!onClicked) + miQuit!onActivated += mainQuit + -- TODO: This should also run "main" too like in most IDEs, + -- but concurrency makes that weird + miRun!onActivated += refreshCommand dat + miProfile!onActivated += runProf dat + miAbout!onActivated += (runDialogRaw wndAbout >> closeWindow wndAbout) + + return () + + where + runDialogRaw = dialogRun . castToDialog . getWindowRaw + closeWindow = widgetHide . getWindowRaw + +-- +-- Sends entered text to processes +-- +fireCommand :: Data -> IO () +fireCommand dat@Data{txtOut=txtOut, txtIn=txtIn} = do + handles <- getHandles dat + hist <- getVar $ history dat + case handles of + Nothing -> errorMessage dat "Can't send command; compiler not running." + Just (Handles inp _ _ _) -> do + s <- getVar (txtIn!text) + running dat -< True + appendText dat (s ++ "\n") + forkIO (hPutStrLn inp s) + txtIn!text -< "" + if null $ dropWhile isSpace s + then history dat -< ([], fst hist ++ snd hist) + else history dat -< ([], s : fst hist ++ snd hist) + +refreshCommand :: Data -> IO () +refreshCommand dat = do + path <- getVar $ filename dat + case path of + Nothing -> startEvaluator dat Nothing + Just _ -> startWithFile dat + +-- +-- Stop the currently running process +-- +stopCommand :: Data -> IO () +stopCommand dat = do + handles <- getHandles dat + case handles of + Nothing -> errorMessage dat "No compiler running to stop." + Just (Handles inp pid oid eid) -> do + killThread oid + killThread eid + terminateProcess pid + waitForProcess pid + setHandles dat Nothing + startEvaluator dat Nothing + +-- Get the next oldest command from history +nextHistory :: Data -> IO () +nextHistory dat@Data {txtIn=txtIn} = do + h <- getVar $ history dat + case h of + (xs, y:ys) -> do + (txtIn!text) -< y + history dat -< (y:xs, ys) + _ -> return () + +-- Get a command that's one newer +previousHistory :: Data -> IO () +previousHistory dat@Data {txtIn=txtIn} = do + h <- getVar $ history dat + case h of + (x:x2:xs, ys) -> do + (txtIn!text) -< x2 + history dat -< (x2:xs, x:ys) + _ -> do + (txtIn!text) -< "" + history dat -< ([], fst h ++ snd h) + +{- +stopCommand :: Data -> IO () +stopCommand dat = do + handles <- getHandles dat + case handles of + Nothing -> return () + Just (pid, inp) -> do + signalProcess sigINT pid +-}
+ Prof.hs view
@@ -0,0 +1,166 @@+-----------------------------------------------------------------------------+-- +-- Module : Prof.hs+-- Copyright : (c) Asumu Takikawa 2007+-- License : +--+-- Maintainer : +-- Stability : unstable+-- Portability : not portable+--+-----------------------------------------------------------------------------++module Prof where++import Data.Char+import System.Directory (doesFileExist)+import System.FilePath+import System.IO+import System.Process+import Text.ParserCombinators.Parsec+import Text.ParserCombinators.Parsec.Token+import Text.ParserCombinators.Parsec.Language (haskellDef)++import Graphics.UI.Gtk+import Graphics.UI.Gtk.ModelView.CellLayout+import qualified Graphics.UI.Gtk.ModelView as MView++import PropLang.Variable++import Data+import Evaluator+import Util++data Profile = Profile+ { title :: String+ , flags :: String+ , time :: String+ , alloc :: String+ }++data ProfileLine = ProfileLine + { costCentre :: String+ , moduleName :: String+ , entries :: Integer+ , indvTime :: Double+ , indvAlloc :: Double+ , inhTime :: Double+ , inhAlloc :: Double + }++--+-- Run the profiler+--+runProf :: Data -> IO ()+runProf dat = do+ cF <- getVar $ profCFlags dat+ rF <- getVar $ profRFlags dat+ o <- getVar $ executable dat+ src <- getVar $ filename dat+ case src of+ Just x -> do+ exist <- doesFileExist x+ if not exist+ then errorMessage dat "Selected file does not exist."+ else do+ (_,_,_,pid) <- runExternal "ghc" $ + Just $ words cF ++ ["-o", o] ++ [x]+ waitForProcess pid+ let exe = if inCurrentDir o then "." </> o else o + (_,_,_,pid2) <- runExternal exe $ Just $ words rF+ waitForProcess pid2+ res <- runProfileParser $ o ++ ".prof"+ case res of+ Left s -> errorMessage dat s + Right p -> runParseDialog p+ Nothing -> do+ errorMessage dat "No file selected for profiling."++ where+ inCurrentDir = null . fst . splitFileName++-- Parse a line+parseProfileLine :: Parser ProfileLine+parseProfileLine = do + let lexer = makeTokenParser haskellDef+ spaces+ cc <- notSpaces ; spaces+ mn <- notSpaces ; spaces+ no <- natural lexer ; spaces+ en <- natural lexer ; spaces+ it <- float lexer ; spaces+ ia <- float lexer ; spaces+ iht <- float lexer ; spaces+ iha <- float lexer+ return $ ProfileLine cc mn en it ia iht iha++ where+ notSpaces = many $ satisfy $ not . isSpace++-- Parse the profiling output+parseProfile :: Parser [ProfileLine]+parseProfile = do+ ls <- many1 parseProfileLine+ return ls++-- Run the profile parsers+runProfileParser :: FilePath -> IO (Either String (Profile, [ProfileLine]))+runProfileParser file = do+ b <- doesFileExist file+ if not b + then return $ Left "No .prof file was found. Check that there are no compile errors or missing profiling flags."+ else do+ contents <- readFile file + let (title:_:flags:_:time:alloc:rest) = lines contents+ prof = Profile (dropWhile isSpace title) (dropWhile isSpace flags)+ (dropWhile isSpace time) (dropWhile isSpace alloc)+ case parse parseProfile "" (unlines $ drop 11 $ rest) of+ Left x -> return $ Left $ "Parse error: " ++ show x ++ "\n\n" +++ "This is likely a bug. Please file a report."+ Right x -> return $ Right (prof, x)++-- Set up and display the profiling dialog+runParseDialog :: (Profile, [ProfileLine]) -> IO ()+runParseDialog (p, ls) = do+ d <- dialogNew+ dialogAddButton d "gtk-close" ResponseClose+ up <- dialogGetUpper d+ titleLabel <- labelNew $ Just $ title p+ flagLabel <- labelNew $ Just $ flags p+ timeLabel <- labelNew $ Just $ time p+ allocLabel <- labelNew $ Just $ alloc p+ + view <- MView.treeViewNew+ store <- MView.treeStoreNew []+ MView.treeViewSetModel view store++ -- Thanks to the Gtk2hs folks for this+ let createTextColumn name field = do+ column <- MView.treeViewColumnNew+ MView.treeViewAppendColumn view column+ MView.treeViewColumnSetTitle column name+ cell <- cellRendererTextNew+ MView.treeViewColumnPackStart column cell True+ cellLayoutSetAttributes column cell store+ (\record -> [MView.cellText := field record])+ + createTextColumn "Cost Centre" costCentre+ createTextColumn "Module" moduleName+ createTextColumn "Entries" (show . entries)+ createTextColumn "Individual %time" (show . indvTime)+ createTextColumn "Individual %alloc" (show . indvAlloc)+ createTextColumn "Inherited %time" (show . inhTime)+ createTextColumn "Inherited %alloc" (show . inhAlloc)++ mapM_ (MView.treeStoreInsert store [] 0) ls++ boxPackStart up titleLabel PackNatural 0+ boxPackStart up flagLabel PackNatural 0+ boxPackStart up timeLabel PackNatural 0+ boxPackStart up allocLabel PackNatural 0+ boxPackStart up view PackRepel 0+ + widgetShowAll d+ dialogRun d+ widgetHide d+ return ()
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ Text/EscapeCodes.hs view
@@ -0,0 +1,69 @@+ +module Text.EscapeCodes where + +import Data.Char +import Data.Maybe + + +data Attribute = Normal | Bold | Underline | Blink | Reverse | Invisible + deriving (Show, Eq) + +data Color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White + deriving (Show, Eq, Enum, Bounded) + + +data EscapeCode = FormatAttribute Attribute + | FormatForeground Color + | FormatBackground Color + | FormatUnknown Int + deriving (Show, Eq) + + +escapeChar :: Char +escapeChar = chr 27 + + +parseEscapeCodes :: String -> [Either Char EscapeCode] +parseEscapeCodes x = f 0 x + where + f 0 (c1:c2:cs) | c1 == escapeChar && c2 == '[' = f 1 cs + + f 1 (c:cs) | isDigit c = Right (g $ read a) : f 2 b + where (a,b) = span isDigit (c:cs) + + f 2 (';':cs) = f 1 cs + f 2 ('m':cs) = f 0 cs + + -- defensive coding, never pattern match + -- always continue producing + f _ (c:cs) = Left c : f 0 cs + f _ [] = [] + + + g :: Int -> EscapeCode + g x | x >= 30 && x <= 37 = FormatForeground $ toEnum (x - 30) + | x >= 40 && x <= 47 = FormatBackground $ toEnum (x - 40) + | otherwise = case lookup x attribs of + Nothing -> FormatUnknown x + Just y -> FormatAttribute y + + attribs = [(0, Normal), + (1, Bold), + (4, Underline), + (5, Blink), + (7, Reverse), + (8, Invisible)] + + +getColor :: Color -> (Int,Int,Int) +getColor x = case lookup x colors of + Nothing -> (0,0,0) + Just t -> t + where + colors = [(Black, (0,0,0)), + (Red, (h,0,0)), + (Green, (0,h,0)), + (White, (f,f,f))] + + h = 0x80 + f = 0xff
+ Util.hs view
@@ -0,0 +1,15 @@+++module Util where++import PropLang.Gtk++import Data+import Graphics.UI.Gtk++errorMessage :: Data -> String -> IO ()+errorMessage dat msg = do+ let parent = getWindowRaw (window dat)+ md <- messageDialogNew (Just parent) [] MessageError ButtonsOk msg+ dialogRun md+ widgetHide md
+ res/about.glade view
@@ -0,0 +1,39 @@+<?xml version="1.0" encoding="UTF-8" standalone="no"?>+<!DOCTYPE glade-interface SYSTEM "glade-2.0.dtd">+<!--Generated with glade3 3.2.2 on Thu Aug 2 05:21:49 2007 by asumu@totoro-->+<glade-interface>+ <widget class="GtkAboutDialog" id="wndAbout">+ <property name="events">GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK</property>+ <property name="border_width">5</property>+ <property name="title" translatable="yes">About GuiHaskell</property>+ <property name="resizable">False</property>+ <property name="window_position">GTK_WIN_POS_CENTER_ON_PARENT</property>+ <property name="type_hint">GDK_WINDOW_TYPE_HINT_DIALOG</property>+ <property name="has_separator">False</property>+ <property name="name">GuiHaskell</property>+ <property name="version">0.0a</property>+ <property name="copyright" translatable="yes">Copyright 2007</property>+ <property name="comments" translatable="yes">A Haskell IDE written in Haskell.</property>+ <property name="website">http://www-users.cs.york.ac.uk/~ndm/guihaskell/</property>+ <property name="authors">Neil Mitchell, Asumu Takikawa</property>+ <property name="documenters"></property>+ <child internal-child="vbox">+ <widget class="GtkVBox" id="dialog-vbox3">+ <property name="visible">True</property>+ <property name="events">GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK</property>+ <property name="spacing">2</property>+ <child internal-child="action_area">+ <widget class="GtkHButtonBox" id="dialog-action_area3">+ <property name="visible">True</property>+ <property name="events">GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK</property>+ <property name="layout_style">GTK_BUTTONBOX_END</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="pack_type">GTK_PACK_END</property>+ </packing>+ </child>+ </widget>+ </child>+ </widget>+</glade-interface>
+ res/guihaskell.glade view
@@ -0,0 +1,524 @@+<?xml version="1.0" encoding="UTF-8" standalone="no"?>+<!DOCTYPE glade-interface SYSTEM "glade-2.0.dtd">+<!--*- mode: xml -*-->+<glade-interface>+ <widget class="GtkWindow" id="wndMain">+ <property name="width_request">300</property>+ <property name="height_request">450</property>+ <property name="visible">True</property>+ <property name="title" translatable="yes">GuiHaskell</property>+ <property name="icon_name">gtk-yes</property>+ <child>+ <widget class="GtkVBox" id="vbox1">+ <property name="visible">True</property>+ <child>+ <widget class="GtkMenuBar" id="menubar1">+ <property name="visible">True</property>+ <child>+ <widget class="GtkMenuItem" id="miFile">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_File</property>+ <property name="use_underline">True</property>+ <child>+ <widget class="GtkMenu" id="menuitem1_menu">+ <child>+ <widget class="GtkImageMenuItem" id="miOpen">+ <property name="visible">True</property>+ <property name="label">gtk-open</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ <signal name="activate" handler="evalFile"/>+ </widget>+ </child>+ <child>+ <widget class="GtkSeparatorMenuItem" id="separatormenuitem1">+ <property name="visible">True</property>+ </widget>+ </child>+ <child>+ <widget class="GtkImageMenuItem" id="miQuit">+ <property name="visible">True</property>+ <property name="label">gtk-quit</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ <signal name="activate" handler="gtk_main_quit"/>+ <accelerator key="q" modifiers="GDK_CONTROL_MASK" signal="activate"/>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ </child>+ <child>+ <widget class="GtkMenuItem" id="miEdit">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_Edit</property>+ <property name="use_underline">True</property>+ <child>+ <widget class="GtkMenu" id="menuitem2_menu">+ <child>+ <widget class="GtkImageMenuItem" id="miCut">+ <property name="visible">True</property>+ <property name="label">gtk-cut</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ <signal name="activate" handler="on_cut1_activate"/>+ </widget>+ </child>+ <child>+ <widget class="GtkImageMenuItem" id="miCopy">+ <property name="visible">True</property>+ <property name="label">gtk-copy</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ <signal name="activate" handler="on_copy1_activate"/>+ </widget>+ </child>+ <child>+ <widget class="GtkImageMenuItem" id="miPaste">+ <property name="visible">True</property>+ <property name="label">gtk-paste</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ <signal name="activate" handler="on_paste1_activate"/>+ </widget>+ </child>+ <child>+ <widget class="GtkImageMenuItem" id="miDelete">+ <property name="visible">True</property>+ <property name="label">gtk-delete</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ <signal name="activate" handler="on_delete1_activate"/>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ </child>+ <child>+ <widget class="GtkMenuItem" id="miView">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_View</property>+ <property name="use_underline">True</property>+ </widget>+ </child>+ <child>+ <widget class="GtkMenuItem" id="miTools">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_Tools</property>+ <property name="use_underline">True</property>+ <child>+ <widget class="GtkMenu" id="menuitem4_menu">+ <child>+ <widget class="GtkImageMenuItem" id="miRun">+ <property name="visible">True</property>+ <property name="events">GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK</property>+ <property name="label" translatable="yes">_Refresh</property>+ <property name="use_underline">True</property>+ <child internal-child="image">+ <widget class="GtkImage" id="menu-item-image2">+ <property name="visible">True</property>+ <property name="events">GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK</property>+ <property name="stock">gtk-refresh</property>+ </widget>+ </child>+ </widget>+ </child>+ <child>+ <widget class="GtkImageMenuItem" id="miProfile">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_Profile</property>+ <property name="use_underline">True</property>+ <child internal-child="image">+ <widget class="GtkImage" id="menu-item-image1">+ <property name="visible">True</property>+ <property name="events">GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK</property>+ <property name="stock">gtk-zoom-fit</property>+ </widget>+ </child>+ </widget>+ </child>+ <child>+ <widget class="GtkSeparatorMenuItem" id="separatormenuitem2">+ <property name="visible">True</property>+ <property name="events">GDK_POINTER_MOTION_MASK | GDK_POINTER_MOTION_HINT_MASK | GDK_BUTTON_PRESS_MASK | GDK_BUTTON_RELEASE_MASK</property>+ </widget>+ </child>+ <child>+ <widget class="GtkImageMenuItem" id="miPref">+ <property name="visible">True</property>+ <property name="label">gtk-preferences</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ </child>+ <child>+ <widget class="GtkMenuItem" id="miHelp">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_Help</property>+ <property name="use_underline">True</property>+ <child>+ <widget class="GtkMenu" id="menuitem4_menu2">+ <child>+ <widget class="GtkImageMenuItem" id="miAbout">+ <property name="visible">True</property>+ <property name="label">gtk-about</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ </packing>+ </child>+ <child>+ <widget class="GtkNotebook" id="notebook1">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="border_width">5</property>+ <property name="show_border">False</property>+ <property name="scrollable">True</property>+ <child>+ <widget class="GtkAlignment" id="alignment1">+ <property name="visible">True</property>+ <property name="bottom_padding">1</property>+ <property name="right_padding">1</property>+ <child>+ <widget class="GtkToolbar" id="toolbar1">+ <property name="visible">True</property>+ <property name="toolbar_style">GTK_TOOLBAR_BOTH_HORIZ</property>+ <child>+ <widget class="GtkToolButton" id="tbRun">+ <property name="visible">True</property>+ <property name="is_important">True</property>+ <property name="label" translatable="yes">Run</property>+ <property name="use_underline">True</property>+ <property name="stock_id">gtk-media-play</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ </packing>+ </child>+ <child>+ <widget class="GtkToolButton" id="tbStop">+ <property name="visible">True</property>+ <property name="is_important">True</property>+ <property name="label" translatable="yes"> Stop</property>+ <property name="use_underline">True</property>+ <property name="stock_id">gtk-stop</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ </packing>+ </child>+ <child>+ <widget class="GtkToolButton" id="tbRestart">+ <property name="visible">True</property>+ <property name="is_important">True</property>+ <property name="label" translatable="yes">Refresh</property>+ <property name="use_underline">True</property>+ <property name="stock_id">gtk-refresh</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ </packing>+ </child>+ <child>+ <widget class="GtkSeparatorToolItem" id="separatortoolitem1">+ <property name="visible">True</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="homogeneous">False</property>+ </packing>+ </child>+ <child>+ <widget class="GtkToolButton" id="tbOpen">+ <property name="visible">True</property>+ <property name="is_important">True</property>+ <property name="label" translatable="yes"> Open</property>+ <property name="use_underline">True</property>+ <property name="stock_id">gtk-open</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ </packing>+ </child>+ <child>+ <widget class="GtkMenuToolButton" id="tbRecent">+ <property name="visible">True</property>+ <property name="is_important">True</property>+ <property name="label" translatable="yes">Recent files</property>+ <property name="use_underline">True</property>+ <property name="stock_id">gtk-file</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="homogeneous">False</property>+ </packing>+ </child>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="tab_expand">False</property>+ </packing>+ </child>+ <child>+ <widget class="GtkLabel" id="label1">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Home</property>+ </widget>+ <packing>+ <property name="type">tab</property>+ <property name="tab_expand">False</property>+ <property name="tab_fill">False</property>+ </packing>+ </child>+ <child>+ <widget class="GtkToolbar" id="toolbar2">+ <property name="visible">True</property>+ <property name="toolbar_style">GTK_TOOLBAR_BOTH_HORIZ</property>+ <child>+ <widget class="GtkToolItem" id="toolitem1">+ <property name="visible">True</property>+ <child>+ <widget class="GtkFontButton" id="fbFont">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="response_id">0</property>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="homogeneous">False</property>+ </packing>+ </child>+ <child>+ <widget class="GtkToolItem" id="toolitem3">+ <property name="visible">True</property>+ <child>+ <widget class="GtkLabel" id="label5">+ <property name="visible">True</property>+ <property name="xpad">4</property>+ <property name="label" translatable="yes">Compiler:</property>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="homogeneous">False</property>+ </packing>+ </child>+ <child>+ <widget class="GtkToolItem" id="toolitem2">+ <property name="visible">True</property>+ <child>+ <widget class="GtkComboBox" id="cbCompiler">+ <property name="visible">True</property>+ <property name="items" translatable="yes">GHCi+Hugs</property>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="homogeneous">False</property>+ </packing>+ </child>+ <child>+ <widget class="GtkToolButton" id="tbPref">+ <property name="visible">True</property>+ <property name="is_important">True</property>+ <property name="stock_id">gtk-preferences</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="position">1</property>+ <property name="tab_expand">False</property>+ </packing>+ </child>+ <child>+ <widget class="GtkLabel" id="label2">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Options</property>+ </widget>+ <packing>+ <property name="type">tab</property>+ <property name="position">1</property>+ <property name="tab_expand">False</property>+ <property name="tab_fill">False</property>+ </packing>+ </child>+ <child>+ <widget class="GtkToolbar" id="toolbar3">+ <property name="visible">True</property>+ <property name="toolbar_style">GTK_TOOLBAR_BOTH_HORIZ</property>+ <child>+ <widget class="GtkToolButton" id="tbProfile">+ <property name="visible">True</property>+ <property name="is_important">True</property>+ <property name="label" translatable="yes">Profile</property>+ <property name="use_underline">True</property>+ <property name="stock_id">gtk-zoom-fit</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="position">2</property>+ <property name="tab_expand">False</property>+ </packing>+ </child>+ <child>+ <widget class="GtkLabel" id="label3">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Tools</property>+ </widget>+ <packing>+ <property name="type">tab</property>+ <property name="position">2</property>+ <property name="tab_expand">False</property>+ <property name="tab_fill">False</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="position">1</property>+ </packing>+ </child>+ <child>+ <widget class="GtkHBox" id="hbox1">+ <property name="visible">True</property>+ <child>+ <widget class="GtkLabel" id="label4">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Selected File:</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="padding">6</property>+ </packing>+ </child>+ <child>+ <widget class="GtkScrolledWindow" id="scrolledwindow4">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="hscrollbar_policy">GTK_POLICY_NEVER</property>+ <property name="vscrollbar_policy">GTK_POLICY_NEVER</property>+ <property name="shadow_type">GTK_SHADOW_IN</property>+ <child>+ <widget class="GtkViewport" id="viewport1">+ <property name="visible">True</property>+ <child>+ <widget class="GtkEntry" id="txtSelect">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="position">1</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">2</property>+ </packing>+ </child>+ <child>+ <widget class="GtkFrame" id="frame1">+ <property name="visible">True</property>+ <property name="label_xalign">0</property>+ <property name="shadow_type">GTK_SHADOW_IN</property>+ <child>+ <widget class="GtkScrolledWindow" id="scrolledwindow2">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="hscrollbar_policy">GTK_POLICY_AUTOMATIC</property>+ <property name="vscrollbar_policy">GTK_POLICY_AUTOMATIC</property>+ <child>+ <widget class="GtkTextView" id="txtOut">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="editable">False</property>+ <property name="wrap_mode">GTK_WRAP_CHAR</property>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="padding">1</property>+ <property name="position">3</property>+ </packing>+ </child>+ <child>+ <widget class="GtkAlignment" id="alignment2">+ <property name="visible">True</property>+ <property name="left_padding">2</property>+ <property name="right_padding">2</property>+ <child>+ <widget class="GtkScrolledWindow" id="scrolledwindow3">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="hscrollbar_policy">GTK_POLICY_NEVER</property>+ <property name="vscrollbar_policy">GTK_POLICY_NEVER</property>+ <property name="shadow_type">GTK_SHADOW_ETCHED_IN</property>+ <child>+ <widget class="GtkTextView" id="txtIn">+ <property name="height_request">20</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="has_focus">True</property>+ <property name="accepts_tab">False</property>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">4</property>+ </packing>+ </child>+ <child>+ <widget class="GtkStatusbar" id="sb">+ <property name="height_request">19</property>+ <property name="visible">True</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">5</property>+ </packing>+ </child>+ </widget>+ </child>+ </widget>+</glade-interface>
+ res/prefdialog.glade view
@@ -0,0 +1,317 @@+<?xml version="1.0" standalone="no"?> <!--*- mode: xml -*-->+<!DOCTYPE glade-interface SYSTEM "http://glade.gnome.org/glade-2.0.dtd">++<glade-interface>++<widget class="GtkWindow" id="wndPref">+ <property name="title" translatable="yes">Preferences</property>+ <property name="type">GTK_WINDOW_TOPLEVEL</property>+ <property name="window_position">GTK_WIN_POS_CENTER</property>+ <property name="modal">True</property>+ <property name="resizable">True</property>+ <property name="destroy_with_parent">False</property>+ <property name="decorated">True</property>+ <property name="skip_taskbar_hint">False</property>+ <property name="skip_pager_hint">False</property>+ <property name="type_hint">GDK_WINDOW_TYPE_HINT_DIALOG</property>+ <property name="gravity">GDK_GRAVITY_NORTH_WEST</property>+ <property name="focus_on_map">True</property>+ <property name="urgency_hint">False</property>++ <child>+ <widget class="GtkVBox" id="vbox1">+ <property name="visible">True</property>+ <property name="homogeneous">False</property>+ <property name="spacing">0</property>++ <child>+ <widget class="GtkNotebook" id="notebook1">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="show_tabs">True</property>+ <property name="show_border">True</property>+ <property name="tab_pos">GTK_POS_TOP</property>+ <property name="scrollable">False</property>+ <property name="enable_popup">False</property>++ <child>+ <widget class="GtkVBox" id="vbox3">+ <property name="visible">True</property>+ <property name="homogeneous">False</property>+ <property name="spacing">0</property>++ <child>+ <widget class="GtkHBox" id="hbox3">+ <property name="visible">True</property>+ <property name="homogeneous">False</property>+ <property name="spacing">0</property>++ <child>+ <widget class="GtkLabel" id="label9">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Executable name: </property>+ <property name="use_underline">False</property>+ <property name="use_markup">False</property>+ <property name="justify">GTK_JUSTIFY_LEFT</property>+ <property name="wrap">False</property>+ <property name="selectable">False</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>+ <property name="width_chars">-1</property>+ <property name="single_line_mode">False</property>+ <property name="angle">0</property>+ </widget>+ <packing>+ <property name="padding">15</property>+ <property name="expand">False</property>+ <property name="fill">False</property>+ </packing>+ </child>++ <child>+ <widget class="GtkEntry" id="txtExecutable">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="editable">True</property>+ <property name="visibility">True</property>+ <property name="max_length">0</property>+ <property name="text" translatable="yes"></property>+ <property name="has_frame">True</property>+ <property name="invisible_char">●</property>+ <property name="activates_default">False</property>+ </widget>+ <packing>+ <property name="padding">15</property>+ <property name="expand">False</property>+ <property name="fill">False</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="padding">0</property>+ <property name="expand">True</property>+ <property name="fill">True</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="tab_expand">False</property>+ <property name="tab_fill">True</property>+ </packing>+ </child>++ <child>+ <widget class="GtkLabel" id="label8">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Compilation</property>+ <property name="use_underline">False</property>+ <property name="use_markup">False</property>+ <property name="justify">GTK_JUSTIFY_LEFT</property>+ <property name="wrap">False</property>+ <property name="selectable">False</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>+ <property name="width_chars">-1</property>+ <property name="single_line_mode">False</property>+ <property name="angle">0</property>+ </widget>+ <packing>+ <property name="type">tab</property>+ </packing>+ </child>++ <child>+ <widget class="GtkVBox" id="vbox2">+ <property name="visible">True</property>+ <property name="homogeneous">False</property>+ <property name="spacing">0</property>++ <child>+ <widget class="GtkHBox" id="hbox1">+ <property name="visible">True</property>+ <property name="homogeneous">False</property>+ <property name="spacing">0</property>++ <child>+ <widget class="GtkLabel" id="label6">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Compile Flags:</property>+ <property name="use_underline">False</property>+ <property name="use_markup">False</property>+ <property name="justify">GTK_JUSTIFY_LEFT</property>+ <property name="wrap">False</property>+ <property name="selectable">False</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>+ <property name="width_chars">-1</property>+ <property name="single_line_mode">False</property>+ <property name="angle">0</property>+ </widget>+ <packing>+ <property name="padding">15</property>+ <property name="expand">False</property>+ <property name="fill">False</property>+ </packing>+ </child>++ <child>+ <widget class="GtkEntry" id="txtProfCFlags">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="editable">True</property>+ <property name="visibility">True</property>+ <property name="max_length">0</property>+ <property name="text" translatable="yes"></property>+ <property name="has_frame">True</property>+ <property name="invisible_char">●</property>+ <property name="activates_default">False</property>+ </widget>+ <packing>+ <property name="padding">15</property>+ <property name="expand">False</property>+ <property name="fill">False</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="padding">0</property>+ <property name="expand">True</property>+ <property name="fill">True</property>+ </packing>+ </child>++ <child>+ <widget class="GtkHBox" id="hbox2">+ <property name="visible">True</property>+ <property name="homogeneous">False</property>+ <property name="spacing">0</property>++ <child>+ <widget class="GtkLabel" id="label7">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Runtime Flags:</property>+ <property name="use_underline">False</property>+ <property name="use_markup">False</property>+ <property name="justify">GTK_JUSTIFY_LEFT</property>+ <property name="wrap">False</property>+ <property name="selectable">False</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>+ <property name="width_chars">-1</property>+ <property name="single_line_mode">False</property>+ <property name="angle">0</property>+ </widget>+ <packing>+ <property name="padding">15</property>+ <property name="expand">False</property>+ <property name="fill">False</property>+ </packing>+ </child>++ <child>+ <widget class="GtkEntry" id="txtProfRFlags">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="editable">True</property>+ <property name="visibility">True</property>+ <property name="max_length">0</property>+ <property name="text" translatable="yes"></property>+ <property name="has_frame">True</property>+ <property name="invisible_char">●</property>+ <property name="activates_default">False</property>+ </widget>+ <packing>+ <property name="padding">15</property>+ <property name="expand">False</property>+ <property name="fill">False</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="padding">0</property>+ <property name="expand">True</property>+ <property name="fill">True</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="tab_expand">False</property>+ <property name="tab_fill">True</property>+ </packing>+ </child>++ <child>+ <widget class="GtkLabel" id="label3">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Profiler</property>+ <property name="use_underline">False</property>+ <property name="use_markup">False</property>+ <property name="justify">GTK_JUSTIFY_LEFT</property>+ <property name="wrap">False</property>+ <property name="selectable">False</property>+ <property name="xalign">0.5</property>+ <property name="yalign">0.5</property>+ <property name="xpad">0</property>+ <property name="ypad">0</property>+ <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>+ <property name="width_chars">-1</property>+ <property name="single_line_mode">False</property>+ <property name="angle">0</property>+ </widget>+ <packing>+ <property name="type">tab</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="padding">10</property>+ <property name="expand">True</property>+ <property name="fill">True</property>+ </packing>+ </child>++ <child>+ <widget class="GtkToolbar" id="toolbar1">+ <property name="visible">True</property>+ <property name="orientation">GTK_ORIENTATION_HORIZONTAL</property>+ <property name="toolbar_style">GTK_TOOLBAR_BOTH_HORIZ</property>+ <property name="tooltips">True</property>+ <property name="show_arrow">True</property>++ <child>+ <widget class="GtkToolButton" id="tbClose">+ <property name="visible">True</property>+ <property name="stock_id">gtk-close</property>+ <property name="visible_horizontal">True</property>+ <property name="visible_vertical">True</property>+ <property name="is_important">True</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="homogeneous">True</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="padding">4</property>+ <property name="expand">False</property>+ <property name="fill">False</property>+ </packing>+ </child>+ </widget>+ </child>+</widget>++</glade-interface>