Mon Nov 26 16:51:45 WET 2007 Miguel Vilaca <jmvilaca@di.uminho.pt>
* Symbol Deletion
Safe symbol deletion with check of symbol's occurrences.
{
hunk ./src/CommonUI.hs 363
+ , on mouse := \ev -> safetyNet frame $ mouseSymbol ev name action state
+ , tooltip := name
hunk ./src/CommonUI.hs 378
+mouseSymbol :: InfoKind n g => EventMouse -> String -> (String -> State g n e -> IO ()) -> State g n e -> IO ()
+mouseSymbol mouseEV name action state =
+ case mouseEV of
+ MouseLeftUp _ _ -> action name state
+ MouseRightUp _ _ -> removeSymbolUI name state
+ _ -> return ()
hunk ./src/CommonUI.hs 409
+removeSymbolUI :: (InfoKind n g) => String -> State g n e -> IO ()
+removeSymbolUI name state =
+ when (name /= "interface") $
+ do contextMenu <- menuPane []
+ menuItem contextMenu
+ [ text := "Remove symbol"
+ , on command := removeSymbol name state
+ ]
+ theFrame <- getNetworkFrame state
+ pointWithinWindow <- windowGetMousePosition theFrame
+ menuPopup contextMenu pointWithinWindow theFrame
+ objectDelete contextMenu
+
+-- | Removes a symbol if it is not used or else don't remove and list its occurrences.
+removeSymbol :: (InfoKind n g) => String -> State g n e -> IO ()
+removeSymbol name state =
+ do theFrame <- getNetworkFrame state
+ if name == "interface"
+ then warningDialog theFrame "Deletion forbidden" "Interface symbol is a special one that can't be deleted."
+ else
+ do
+ pDoc <- getDocument state
+ doc <- PD.getDocument pDoc
+
+ let newpal = deleteShape name $ getPalette doc
+ symbs = map fst . shapes $ newpal
+ errors = undefinedAgents symbs doc
+ if Map.null errors
+ then do -- symbol can be safely removed
+ remove <- confirmDialog theFrame "Symbol deletion"
+ ("Symbol \"" ++ name ++
+ "\" can be safely removed.\nAre you sure you want to delete it?")
+ False
+ if remove
+ then do PD.updateDocument ("Symbol " ++ name ++ " removed") (setPalette newpal) pDoc
+ buildVisiblePalette state
+ else return ()
+
+ else -- there are occurrences of symbol; list them
+ errorDialog theFrame "Deletion forbidden" $
+ "Symbol \"" ++ name ++
+ "\" can't be deleted because there are the following occurrences of it in the IN system:\n"
+ ++ (unlines . map show $ Map.keys errors)
+
hunk ./src/INChecks.hs 25
+ -- * Other functions useful elsewhere
+ , undefinedAgents
hunk ./src/Palette.hs 3
-import List (nub, (\\))
+import List (nub, (\\), deleteBy)
hunk ./src/Palette.hs 22
+deleteShape :: String -> Palette a -> Palette a
+deleteShape name (Palette p) = Palette $ deleteBy equal (name, undefined) p
+ where equal (name1,_) (name2,_) = name1 == name2
+
}