Permalink
Browse files

Select & Evaluate is ready

  • Loading branch information...
Fernando Benavides Fernando Benavides
Fernando Benavides authored and Fernando Benavides committed Oct 12, 2009
1 parent 2ff0e31 commit 43d345d10091aa979d1e1471b60de2efbacad835
Showing with 76 additions and 13 deletions.
  1. +1 −0 .gitignore
  2. +3 −0 README
  3. +1 −1 hpage.cabal
  4. +1 −0 res/help/helpPage.hs
  5. +70 −12 src/HPage/GUI/FreeTextWindow.hs
View
@@ -1,3 +1,4 @@
+.project
out
bin
bin/hPage.app/Contents/MacOS/hPage
View
3 README
@@ -32,4 +32,7 @@ Now if you place your cursor on something like...
fact 20
... you can ask for its value or type
+
+Also, instead of just placing your cursor on a expression, you can mark an area and hpage will evaluate just that area
+
That's just to start up... you can do some serious stuff with this application, just check out the different menues
View
@@ -1,5 +1,5 @@
name: hpage
-version: 0.2.1
+version: 0.2.2
cabal-version: >=1.6
build-type: Custom
license: BSD3
View
@@ -25,5 +25,6 @@ fact x = foldl (*) 1 [1..x]
fact 20
+-- If you don't want to use the whole page content in an evaluation, you can mark the exact page zone you want to evaluate
-- That's just to start up... you can do some serious stuff with this application, just surf the different menues
@@ -453,10 +453,66 @@ runHP hpacc model guiCtx@GUICtx{guiWin = win} =
Right () ->
refreshPage model guiCtx
-runTxtHP :: HP.HPage (MVar (Either HP.InterpreterError String)) ->
- HPS.ServerHandle -> GUIContext -> GUIResultRow -> IO ()
-runTxtHP hpacc model guiCtx@GUICtx{guiWin = win,
- guiStatus = status}
+runTxtHP, runTxtHPPointer :: HP.HPage (MVar (Either HP.InterpreterError String)) ->
+ HPS.ServerHandle -> GUIContext -> GUIResultRow -> IO ()
+runTxtHPSelection :: String -> HP.HPage (MVar (Either HP.InterpreterError String)) ->
+ HPS.ServerHandle -> GUIContext -> GUIResultRow -> IO ()
+runTxtHP hpacc model guiCtx@GUICtx{guiCode = txtCode} guiRow =
+ do
+ sel <- textCtrlGetStringSelection txtCode
+ let runner = case sel of
+ "" -> runTxtHPPointer
+ sl -> runTxtHPSelection sl
+ runner hpacc model guiCtx guiRow
+
+runTxtHPSelection s hpacc model guiCtx@GUICtx{guiWin = win,
+ guiStatus = status}
+ GUIRRow{grrButton = btn,
+ grrText = txtBox} =
+ do
+ refreshExpr model guiCtx False
+ debugIO ("evaluating selection", s)
+ let newacc = do
+ HP.addPage
+ HP.setPageText s $ length s
+ hpacc
+ res <- tryIn' model newacc
+ tryIn' model HP.closePage
+ case res of
+ Left err -> warningDialog win "Error" err
+ Right var -> do
+ cancelled <- varCreate False
+ prevOnCmd <- get btn $ on command
+ prevText <- get btn text
+ let prevAttrs = [text := prevText,
+ on command := prevOnCmd]
+ revert = do
+ varSet cancelled True
+ tryIn' model HP.cancel
+ set txtBox [enabled := True]
+ set btn prevAttrs
+ set status [text := "cancelled"]
+ set btn [text := "Cancel", on command := revert]
+ set txtBox [enabled := False]
+ set status [text := "processing..."]
+ spawn . liftIO $ do
+ val <- readMVar var
+ wasCancelled <- varGet cancelled
+ if wasCancelled
+ then
+ return ()
+ else
+ do
+ set status [text := "ready"]
+ case val of
+ Left err -> warningDialog win "Error" $ HP.prettyPrintError err
+ Right txt -> set txtBox [text := txt]
+ set txtBox [enabled := True]
+ set btn prevAttrs
+ return ()
+
+runTxtHPPointer hpacc model guiCtx@GUICtx{guiWin = win,
+ guiStatus = status}
GUIRRow{grrButton = btn,
grrText = txtBox} =
do
@@ -470,29 +526,31 @@ runTxtHP hpacc model guiCtx@GUICtx{guiWin = win,
prevText <- get btn text
let prevAttrs = [text := prevText,
on command := prevOnCmd]
- set btn [text := "Cancel",
- on command := cancelHP model cancelled]
+ revert = do
+ varSet cancelled True
+ tryIn' model HP.cancel
+ set txtBox [enabled := True]
+ set btn prevAttrs
+ set status [text := "cancelled"]
+ set btn [text := "Cancel", on command := revert]
set txtBox [enabled := False]
set status [text := "processing..."]
spawn . liftIO $ do
val <- readMVar var
wasCancelled <- varGet cancelled
if wasCancelled
then
- set status [text := "cancelled"]
+ return ()
else
do
set status [text := "ready"]
case val of
Left err -> warningDialog win "Error" $ HP.prettyPrintError err
Right txt -> set txtBox [text := txt]
- set txtBox [enabled := True]
- set btn prevAttrs
+ set txtBox [enabled := True]
+ set btn prevAttrs
return ()
-cancelHP :: HPS.ServerHandle -> Var Bool -> IO ()
-cancelHP model cancelled = varSet cancelled True >> tryIn' model HP.cancel >> return ()
-
refreshExpr :: HPS.ServerHandle -> GUIContext -> Bool -> IO ()
refreshExpr model guiCtx@GUICtx{guiResults = GUIRes{resValue = grrValue,
resType = grrType,

0 comments on commit 43d345d

Please sign in to comment.