[Fencommits] fenfire-hs: refactor addprop code

[Benja Fallenstein]

Mon Feb 19 17:23:11 EET 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * refactor addprop code
diff -rN -u old-fenfire-hs/Fenfire.fhs new-fenfire-hs/Fenfire.fhs
--- old-fenfire-hs/Fenfire.fhs	2007-02-20 17:38:59.000000000 +0200
+++ new-fenfire-hs/Fenfire.fhs	2007-02-20 17:38:59.000000000 +0200
@@ -564,6 +564,8 @@
         "chgview" -> do put $ state { fsView = (fsView state + 1) `mod` 
                                                (length ?views) }
                         setInterp True
+        "addprop" -> put $ state { fsProperty = node,
+                             fsPropertyList = fsPropertyList state ++ [node] }
         "resetprop" -> when (fsProperty state /= rdfs_seeAlso) $
                            put $ state { fsProperty = rdfs_seeAlso }
         "changeURI" -> case node of
@@ -648,8 +650,6 @@
                stockStrikethrough , Just "<Alt>BackSpace" )
             , ("loadURI", Just "_Load node's URI"           ,
                stockGoForward     , Just "<Ctl>L"         )
-            , ("changeURI", Just "Change node's _URI"       ,
-               stockRefresh       , Just "u"              )
             ]
     forM bindingentries $ \(name,label',stock,accel) -> do 
         action <- actionNew name label' Nothing (Just stock)
@@ -762,7 +762,7 @@
     textViewSetWrapMode textView WrapWordChar
 
     -- this needs to be called whenever the node or its text changes:
-    let stateChanged (FenState { fsRotation=Rotation n _, fsGraph=g }) = do
+    let stateChanged _ (FenState { fsRotation=Rotation n _, fsGraph=g }) = do
             buf <- textBufferNew Nothing
             textBufferSetText buf (let ?graph=g in maybe "" id $ getText n)
             afterBufferChanged buf $ do 
@@ -780,6 +780,7 @@
                 updateCanvas True
 
             textViewSetBuffer textView buf
+            updatePropMenu propmenu actionGroup stateRef updateCanvas
             updateActions actionGroup stateRef
 
     -- canvas for view:
@@ -817,9 +818,9 @@
     makeBindings actionGroup fake
 
     actions <- actionGroupListActions actionGroup
-    bindingActions0 <- actionGroupListActions bindingGroup
+    bindingActions <- actionGroupListActions bindingGroup
 
-    forM_ (actions ++ bindingActions0) $ \action -> do
+    forM_ (actions ++ bindingActions) $ \action -> do
         name <- actionGetName action
         onActionActivate action $ canvasAction name >> return ()
         
@@ -837,20 +838,6 @@
     forM_ (tail viewActs) $ \x -> radioActionSetGroup x (head viewActs)
     toggleActionSetActive (toToggleAction $ head viewActs) True
 
-    forM_ [(bindingGroup, bindings), (actionGroup, fake)] $ \(grp, bds) -> do
-        addProp <- actionNew "addprop" (Just "Make _focused node a property")
-                             Nothing (Just stockAdd)
-        actionGroupAddActionWithAccel grp addProp (Just "<Shift>P")
-        actionSetAccelGroup addProp bds
-        onActionActivate addProp $ do
-            modifyIORef stateRef $ \s -> 
-                let Rotation n _ = fsRotation s
-                 in s { fsProperty=n, fsPropertyList=fsPropertyList s ++ [n] }
-            updatePropMenu propmenu actionGroup stateRef updateCanvas
-            updateCanvas False
-
-    bindingActions <- actionGroupListActions bindingGroup
-
     -- user interface widgets:
 
     menubar <- menuBarNew
@@ -888,8 +875,8 @@
 
     -- start:
 
-    readIORef stateRef >>= stateChanged
-    updatePropMenu propmenu actionGroup stateRef updateCanvas
+    startState <- readIORef stateRef
+    stateChanged (startState { fsPropertyList = [] }) startState
     
     widgetGrabFocus canvas
 
diff -rN -u old-fenfire-hs/Vobs.fhs new-fenfire-hs/Vobs.fhs
--- old-fenfire-hs/Vobs.fhs	2007-02-20 17:38:59.000000000 +0200
+++ new-fenfire-hs/Vobs.fhs	2007-02-20 17:38:59.000000000 +0200
@@ -326,7 +326,7 @@
     
 
 vobCanvas :: Ord b => IORef a -> View a b -> Handler Event a -> 
-                      Handler c a -> (a -> IO ()) -> Color -> TimeDiff ->
+                      Handler c a -> (a -> a -> IO ()) -> Color -> TimeDiff ->
                       IO (DrawingArea, Bool -> IO (), c -> IO Bool)
 vobCanvas stateRef view eventHandler actionHandler stateChanged 
           bgColor animTime = do
@@ -371,7 +371,7 @@
                 runHandler handler state event
 
             when handled $ do writeIORef stateRef state'
-                              stateChanged state'
+                              stateChanged state state'
                               updateAnim interpolate'
 
             return handled
diff -rN -u old-fenfire-hs/VobTest.fhs new-fenfire-hs/VobTest.fhs
--- old-fenfire-hs/VobTest.fhs	2007-02-20 17:38:59.000000000 +0200
+++ new-fenfire-hs/VobTest.fhs	2007-02-20 17:38:59.000000000 +0200
@@ -162,8 +162,8 @@
                            setInterp True
 
     (canvas, _updateCanvas, _canvasAction) <- vobCanvas stateRef view handle 
-                                                        (const $ return ()) 
-                                                        (const $ return ()) 
+                                                        (\_   -> return ()) 
+                                                        (\_ _ -> return ()) 
                                                         lightGray 3
 
     set window [ containerChild := canvas ]