diff --git a/Blobs.cabal b/Blobs.cabal
--- a/Blobs.cabal
+++ b/Blobs.cabal
@@ -1,5 +1,5 @@
 Name:            Blobs
-Version:         0.2
+Version:         0.3
 License:         LGPL
 License-file:    LICENCE-LGPL
 Author:          Arjan van IJzendoorn, Martijn Schrage, Malcolm Wallace
@@ -32,8 +32,14 @@
   simple.blobpalette, wiring.blobs
 
 library
-  Build-Depends:   base >= 4 && < 5, haskell98, wx >= 0.9, wxcore >= 0.9, HaXml >= 1.14
-                   , polyparse, directory, pretty, containers
+  Build-Depends:   base >= 4 && < 5
+                   , wx >= 0.9
+                   , wxcore >= 0.9
+                   , HaXml >= 1.22.5
+                   , polyparse
+                   , directory
+                   , pretty
+                   , containers
   Hs-Source-Dirs:  src lib/DData
   exposed-modules: Graphics.Blobs.Colors
                  , Graphics.Blobs.Common
@@ -58,16 +64,15 @@
                  , Graphics.Blobs.Shape
                  , Graphics.Blobs.State
                  , Graphics.Blobs.StateUtil
-                 -- , Graphics.Blobs.XTC
   -- other-modules:   Graphics.Blobs
-  ghc-options:     -Wall
+  ghc-options:     -Wall -fno-warn-unused-do-bind
 
 executable blobs
   main-is: Main.hs
-  Build-Depends:   base >= 4 && < 5, haskell98, wx >= 0.9, wxcore >= 0.9, HaXml >= 1.14
+  Build-Depends:   base >= 4 && < 5, wx >= 0.9, wxcore >= 0.9, HaXml >= 1.14
                    , polyparse, directory, pretty, containers
   Hs-Source-Dirs:  src lib/DData
-  ghc-options:     -Wall
+  ghc-options:     -Wall -fno-warn-unused-do-bind
 
 source-repository head
   type:     git
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -3,7 +3,26 @@
 
 Blobs from http://www.cs.york.ac.uk/fp/darcs/Blobs/
 
+Note: wxc-0.90.0.3 fails to compile, see
+https://sourceforge.net/tracker/?func=detail&atid=536845&aid=3536406&group_id=73133
+
+
+A workaround: wxc install fails with eljpen.cpp not compiling.
+
+Change line 159 to
+
+ *_ref = ((const char* const*)NULL);
+
+from
+
+ *_ref = NULL;
+
+
+
 Changes
+
+0.3 Introduce class GuiEdit and GuiGlobalEdit to allow custom dialogs
+    for editing the global,node and edge attributes
 
 0.2 Move the contents into the Graphics.Blobs namespace
 
diff --git a/src/Graphics/Blobs/Colors.hs b/src/Graphics/Blobs/Colors.hs
--- a/src/Graphics/Blobs/Colors.hs
+++ b/src/Graphics/Blobs/Colors.hs
@@ -3,7 +3,9 @@
 import Graphics.UI.WX
 import Text.Parse
 
+import qualified Text.XML.HaXml.XmlContent.Haskell as XML
 
+
 -- Different spelling of colour/color to distinguish local/wx datatypes.
 data Colour = RGB !Int !Int !Int deriving (Eq,Show,Read)
 
@@ -84,3 +86,25 @@
 orangeRed = RGB 255 69 0
 gold = RGB 255 215 0
 darkSlateGray = RGB 47 79 79
+
+-- ---------------------------------------------------------------------
+-- Migrating orphan instances home
+
+{- derived by DrIFT -}
+instance XML.HTypeable Colour where
+    toHType v = XML.Defined "Colour" []
+                   [XML.Constr "RGB" [] [XML.toHType aa,XML.toHType ab,XML.toHType ac]]
+      where (RGB aa ab ac) = v
+instance XML.XmlContent Colour where
+    parseContents = do
+        { XML.inElement "RGB" $ do
+              { aa <- XML.parseContents
+              ; ab <- XML.parseContents
+              ; ac <- XML.parseContents
+              ; return (RGB aa ab ac)
+              }
+        }
+    toContents v@(RGB aa ab ac) =
+        [XML.mkElemC (XML.showConstr 0 (XML.toHType v))
+                 (concat [XML.toContents aa, XML.toContents ab, XML.toContents ac])]
+
diff --git a/src/Graphics/Blobs/Common.hs b/src/Graphics/Blobs/Common.hs
--- a/src/Graphics/Blobs/Common.hs
+++ b/src/Graphics/Blobs/Common.hs
@@ -1,12 +1,11 @@
 module Graphics.Blobs.Common (module Graphics.Blobs.Common {-, module IOExts-}, module Graphics.Blobs.Colors) where
 
 import Graphics.Blobs.Colors
--- import IOExts(trace)
 import Debug.Trace (trace)
 import qualified Data.IntMap as IntMap
-import Char(isSpace)
+import Data.Char(isSpace)
 import GHC.Float(formatRealFloat, FFFormat(FFFixed))
-import List
+import Data.List
 
 -- | return a list of all cartesian products for a list of lists
 --   e.g. products [[1,2],[3,4]] = [[1,3],[1,4],[2,3],[2,4]]
diff --git a/src/Graphics/Blobs/CommonIO.hs b/src/Graphics/Blobs/CommonIO.hs
--- a/src/Graphics/Blobs/CommonIO.hs
+++ b/src/Graphics/Blobs/CommonIO.hs
@@ -1,14 +1,15 @@
 module Graphics.Blobs.CommonIO where
 
-import Graphics.Blobs.Math
+import Data.Char
+import Data.List(elemIndex)
 import Graphics.Blobs.Common(ifJust, internalError, tabDelimited, safeIndex, systemGrey)
+import Graphics.Blobs.Math
 import Graphics.Blobs.SafetyNet
-
 import Graphics.UI.WX
 import Graphics.UI.WXCore
-import List(elemIndex)
 import System.Directory
 import System.IO
+import Text.Parse
 
 ignoreResult :: IO a -> IO ()
 ignoreResult action = do { action; return () }
@@ -64,10 +65,10 @@
 
 myTextDialog :: Window a -> TextCtrlSize -> String -> String -> Bool
                 -> IO (Maybe String)
-myTextDialog parentWindow size dialogTitle initial selectAll =
+myTextDialog parentWindow lineSize dialogTitle initial selectAll =
   do{ d <- dialog parentWindow [text := dialogTitle]
-    ; textInput <- (case size of SingleLine -> textEntry;
-                                 MultiLine  -> textCtrl)
+    ; textInput <- (case lineSize of SingleLine -> textEntry;
+                                     MultiLine  -> textCtrl)
                          d [ alignment := AlignLeft, text := initial ]
     ; ok    <- button d [text := "Ok"]
     ; can   <- button d [text := "Cancel", identity := wxID_CANCEL]
@@ -77,17 +78,17 @@
                                   ]
         --  ,clientSize := case size of SingleLine -> sz 300 40
         --                              MultiLine ->  sz 500 200
-            ,area := case size of SingleLine -> rect (pt 50 50) (sz 300 80)
-                                  MultiLine ->  rect (pt 50 50) (sz 500 250)
+            ,area := case lineSize of SingleLine -> rect (pt 50 50) (sz 300 80)
+                                      MultiLine ->  rect (pt 50 50) (sz 500 250)
             ]
     ; when (selectAll)     $ do textCtrlSetSelection textInput 0 250
     ; when (not selectAll) $ do textCtrlSetInsertionPointEnd textInput
                                 set d [ visible := True ]
-    ; showModal d $ \stop ->
+    ; showModal d $ \stop1 ->
                 do set ok  [on command := safetyNet parentWindow $
                                           do theText <- get textInput text
-                                             stop (Just theText)]
-                   set can [on command := safetyNet parentWindow $ stop Nothing]
+                                             stop1 (Just theText)]
+                   set can [on command := safetyNet parentWindow $ stop1 Nothing]
     }
 
 -- Dialog for selecting a multiple Strings (0 or more)
@@ -129,12 +130,12 @@
                                   ]
             , clientSize := sz 300 400
             ]
-    ; showModal d $ \stop ->
+    ; showModal d $ \stop1 ->
                 do set ok  [on command := safetyNet parentWindow $
                               do indices <- get theListBox selections
-                                 stop (Just (map (safeIndex "CommonIO.multiSelectionDialog" strings) indices))]
+                                 stop1 (Just (map (safeIndex "CommonIO.multiSelectionDialog" strings) indices))]
                    set can [on command := safetyNet parentWindow $
-                                          stop Nothing]
+                                          stop1 Nothing]
     }
 
 -- Dialog for selecting a single String
@@ -162,12 +163,12 @@
                                   ]
             , clientSize := sz 300 400
             ]
-    ; showModal d $ \stop ->
+    ; showModal d $ \stop1 ->
                 do set ok  [on command := safetyNet parentWindow $
                                           do index <- get theListBox selection
-                                             stop (Just (safeIndex "CommonIO.singleSelectionDialog" strings index))]
+                                             stop1 (Just (safeIndex "CommonIO.singleSelectionDialog" strings index))]
                    set can [on command := safetyNet parentWindow $
-                                          stop Nothing]
+                                          stop1 Nothing]
     }
 
 -- | Fill a grid from a list of lists of texts. Each list inside the
@@ -337,3 +338,27 @@
  do { fixIO fIO
     ; return ()
     }
+
+-- ---------------------------------------------------------------------
+
+aTextDialog :: (Show a, Parse a1) =>
+                Window a2 -> String -> a -> IO (Maybe a1)
+aTextDialog parentWindow dialogTitle initial = do
+  result <- myTextDialog parentWindow MultiLine dialogTitle (show initial) True
+  case result of
+    Just str ->
+      case runParser parse str of
+        (Right x, s) ->
+          do{ when (not (null s || all isSpace s)) $
+                  (errorDialog parentWindow "Edit warning"
+                        ("Excess text after parsed value."
+                         ++"\nRemaining text: "++s))
+              ; return (Just x);
+            }
+        (Left err, s) -> do
+          errorDialog parentWindow "Edit warning"
+            ("Cannot parse entered text."
+             ++"\nReason: "++err
+             ++"\nRemaining text: "++s)
+          return Nothing
+    Nothing -> return Nothing
diff --git a/src/Graphics/Blobs/ContextMenu.hs b/src/Graphics/Blobs/ContextMenu.hs
--- a/src/Graphics/Blobs/ContextMenu.hs
+++ b/src/Graphics/Blobs/ContextMenu.hs
@@ -70,6 +70,10 @@
         [ text := "Edit info (i)"
         , on command := safetyNet theFrame $ reinfoNodeOrEdge theFrame state
         ]
+    ; menuItem contextMenu
+        [ text := "Edit info userfunc (u)"
+        , on command := safetyNet theFrame $ reinfoNodeOrEdgeUser theFrame state
+        ]
     ; menuLine contextMenu
     ; menuItem contextMenu
         [ text := "from port "++show fromPort
@@ -119,6 +123,10 @@
         , on command := safetyNet theFrame $ reinfoNodeOrEdge theFrame state
         ]
     ; menuItem contextMenu
+        [ text := "Edit info userfunc (u)"
+        , on command := safetyNet theFrame $ reinfoNodeOrEdgeUser theFrame state
+        ]
+    ; menuItem contextMenu
         [ text := "Change arity (in/"++show i++", out/"++show o++")"
         , on command := safetyNet theFrame $ reArityNode theFrame state
         ]
@@ -152,7 +160,7 @@
                         Left n  -> case lookup n (shapes palette) of
                                      Nothing -> const theInfo
                                      Just (_,Nothing) -> const theInfo
-                                     Just (_,Just i)  -> if i==theInfo then id
+                                     Just (_,Just info)  -> if info==theInfo then id
                                                          else const theInfo
                         Right _ -> const theInfo
     ; menuItem contextMenu
diff --git a/src/Graphics/Blobs/DisplayOptions.hs b/src/Graphics/Blobs/DisplayOptions.hs
--- a/src/Graphics/Blobs/DisplayOptions.hs
+++ b/src/Graphics/Blobs/DisplayOptions.hs
@@ -1,6 +1,6 @@
 module Graphics.Blobs.DisplayOptions where
 
-import List ((\\))
+import Data.List ((\\))
 
 type ShowInfo = [What]
 data What     = GlobalInfo | NodeLabel | NodeInfo | EdgeInfo	deriving (Eq)
diff --git a/src/Graphics/Blobs/GUIEvents.hs b/src/Graphics/Blobs/GUIEvents.hs
--- a/src/Graphics/Blobs/GUIEvents.hs
+++ b/src/Graphics/Blobs/GUIEvents.hs
@@ -1,6 +1,6 @@
 module Graphics.Blobs.GUIEvents where
 
-import List (nub,(\\))
+import Data.List (nub,(\\))
 import Graphics.Blobs.NetworkView(clickedNode, clickedEdge, clickedVia)
 import Graphics.Blobs.NetworkControl
 import Graphics.Blobs.State
@@ -13,7 +13,7 @@
 import Text.Parse
 
 import Graphics.UI.WX
-import Graphics.UI.WXCore
+--import Graphics.UI.WXCore
 
 mouseDown :: (InfoKind n g, InfoKind e g, Show g, Parse g, Descriptor g) =>
              Bool -> Point -> Frame () -> State g n e -> IO ()
diff --git a/src/Graphics/Blobs/InfoKind.hs b/src/Graphics/Blobs/InfoKind.hs
--- a/src/Graphics/Blobs/InfoKind.hs
+++ b/src/Graphics/Blobs/InfoKind.hs
@@ -5,30 +5,55 @@
 module Graphics.Blobs.InfoKind where
 
 import Text.Parse
---import Text.XML.HaXml.XmlContent
 import Text.XML.HaXml.XmlContent.Haskell
+import Graphics.UI.WX
+import Graphics.Blobs.CommonIO
 
 -- | The @InfoKind@ class is a predicate that ensures we can always create
 --   at least a blank (empty) information element, that we can read and
 --   write them to/from the user, and that there exists some method of
 --   determining the correctness of the value (completeness/consistency etc)
 --   against some global type.
-class (Eq a, Show a, Parse a, XmlContent a) => InfoKind a g | a -> g where
+class (Eq a, Show a, Parse a, XmlContent a, XmlContent g, {- GuiEdit a,-} GuiEdit g, GuiGlobalEdit a g) =>
+      InfoKind a g | a -> g where
     blank :: a
     check :: String -> g -> a -> [String]		-- returns warnings
 	-- ^ first arg is container label for error reporting.
 	--   second arg is global value
 
+
 -- A basic instance representing "no info"
 instance InfoKind () () where
     blank = ()
     check _ _ () = []
+
+instance GuiEdit () where
+    editDialog parentWindow dialogTitle initial = aTextDialog parentWindow dialogTitle initial
+
+instance GuiGlobalEdit () g where
+    editDialogWithGlobal parentWindow dialogTitle initial _global = aTextDialog parentWindow dialogTitle initial
+
+
 -- Assume that info is mandatory, but not supplied a priori.
 instance InfoKind a b => InfoKind (Maybe a) b where
     blank = Nothing
     check n _ Nothing  = ["No info value stored with "++n]
     check n g (Just a) = check n g a
 
+instance Descriptor a => Descriptor (Maybe a) where
+  descriptor Nothing  =  "Nothing"
+  descriptor (Just x) =  "Just (" ++ (descriptor x) ++ ")"
+
+{-
+instance (Show a,Parse a, Descriptor a) => GuiEdit (Maybe a) where
+  editDialog _a = undefined
+-}
+
+
+instance (Show a,Parse a, Descriptor a) => GuiGlobalEdit (Maybe a) b where
+  editDialogWithGlobal _a _b = undefined
+
+
 -- A "showType"-style class.  Descriptor should always ignore its argument,
 -- and return a constant string describing the type instead.
 class (Show a) => Descriptor a where
@@ -36,6 +61,26 @@
     descriptor _ = "type descriptor was left undefined"
 instance Descriptor () where
     descriptor _ = "null global info type"
+
+-- -----------------------------------------------
+
+-- A class of things that can be edited in a GUI, falling back to a
+-- simple text editor using Parse/Show
+class (Show a,Parse a,Descriptor a) => GuiEdit a where
+    editDialog :: Window a1 -- ^ Parent frame
+                  -> String -- ^ Window title
+                  -> a      -- ^ Existing value
+                  -> IO (Maybe a) -- ^ Updated value if changed
+
+-- A class of things that can be edited in a GUI, falling back to a
+-- simple text editor using Parse/Show
+class (Show a,Parse a,Descriptor a) => GuiGlobalEdit a g where
+    editDialogWithGlobal :: Window a1 -- ^ Parent frame
+                            -> String -- ^ Window title
+                            -> a      -- ^ Existing value
+                            -> g      -- ^ Global value, for reference
+                            -> IO (Maybe a) -- ^ Updated value if changed
+
 
 -- -----------------------------------------------
 {-
diff --git a/src/Graphics/Blobs/Math.hs b/src/Graphics/Blobs/Math.hs
--- a/src/Graphics/Blobs/Math.hs
+++ b/src/Graphics/Blobs/Math.hs
@@ -13,18 +13,26 @@
     , origin
     , translate
     , enclosedInRectangle
+
+    -- For XML I/O
+    , makeTag
+    , tagWithId
+    , simpleString
+    , escapeString
+    , comment
+    , commentEscape
     ) where
 
 import Graphics.UI.WX(Point, point, pointX, pointY)
 import Text.Parse
 
-{-
-data DoublePoint = DoublePoint
-    { doublePointX :: !Double
-    , doublePointY :: !Double
-    }
-    deriving (Show, Eq, Read)
--}
+import qualified Text.XML.HaXml.XmlContent.Haskell as XML
+import Data.Char
+import Text.XML.HaXml.Escape
+import Text.XML.HaXml.Types
+
+-- ---------------------------------------------------------------------
+
 data DoublePoint = DoublePoint !Double !Double
     deriving (Show, Eq, Read)
 
@@ -35,7 +43,10 @@
 
 data Vector = Vector !Double !Double
 
+doublePointX :: DoublePoint -> Double
 doublePointX (DoublePoint x _) = x
+
+doublePointY :: DoublePoint -> Double
 doublePointY (DoublePoint _ y) = y
 
 origin :: DoublePoint
@@ -108,3 +119,58 @@
   where
     between i j k | j <= k    =  j <= i && i <= k
                   | otherwise =  k <= i && i <= j
+
+-- ---------------------------------------------------------------------
+-- Moving orphan instances home
+instance XML.HTypeable DoublePoint where
+    toHType _ = XML.Defined "DoublePoint" [] [XML.Constr "X" [] [], XML.Constr "Y" [] []]
+instance XML.XmlContent DoublePoint where
+    toContents (DoublePoint x y) =
+        [ simpleString "X"          (show x)
+        , simpleString "Y"          (show y)
+        ]
+    parseContents = do
+        { x <- XML.inElement "X" $ fmap read XML.text
+        ; y <- XML.inElement "Y" $ fmap read XML.text
+        ; return (DoublePoint x y)
+        }
+
+
+---- UTILITY FUNCTIONS
+
+-- Abbreviations
+makeTag :: String -> [XML.Content i] -> XML.Content i
+makeTag tagName children = XML.CElem (XML.Elem (N tagName) [] children) undefined
+
+tagWithId :: String -> String -> [XML.Content i] -> XML.Content i
+tagWithId tagName identity children =
+    XML.CElem (XML.Elem (N tagName) [(N "id", XML.AttValue [Left identity])] children) undefined
+
+-- | A simple string contains no spaces or unsafe characters
+simpleString :: String -> String -> XML.Content i
+simpleString tag value =
+    XML.CElem (XML.Elem (N tag) [] [ XML.CString False value undefined ]) undefined
+
+-- | The string value may contain spaces and unsafe characters
+escapeString :: String -> String -> XML.Content i
+escapeString key value =
+    XML.CElem ((if isSafe value then id else escape) $
+             XML.Elem (N key) [] [ XML.CString (any isSpace value) value undefined ])
+          undefined
+  where
+    isSafe cs = all isSafeChar cs
+    isSafeChar c = isAlpha c || isDigit c || c `elem` "- ."
+
+    escape :: XML.Element i -> XML.Element i
+    escape = xmlEscape stdXmlEscaper
+
+comment :: String -> XML.Content i
+comment s = XML.CMisc (Comment (commentEscape s)) undefined
+
+-- Replace occurences of "-->" with "==>" in a string so that the string
+-- becomes safe for an XML comment
+commentEscape :: String -> String
+commentEscape [] = []
+commentEscape ('-':'-':'>':xs) = "==>" ++ commentEscape xs
+commentEscape (x:xs) = x : commentEscape xs
+
diff --git a/src/Graphics/Blobs/Network.hs b/src/Graphics/Blobs/Network.hs
--- a/src/Graphics/Blobs/Network.hs
+++ b/src/Graphics/Blobs/Network.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE UndecidableInstances #-}
 module Graphics.Blobs.Network
     (
     -- * Types
@@ -53,6 +54,7 @@
     , setEdgeFrom, setEdgeTo, setEdgeVia, setEdgeInfo
     , getEdgeFromPort, getEdgeToPort
     , setEdgeFromPort, setEdgeToPort
+
     ) where
 
 import Graphics.Blobs.Common
@@ -63,6 +65,13 @@
 
 import qualified Data.IntMap as IntMap -- hiding (map)
 
+import Text.XML.HaXml.Combinators (replaceAttrs)
+import Text.XML.HaXml.Types
+import Text.XML.HaXml.Verbatim
+import qualified Text.XML.HaXml.XmlContent.Haskell as XML
+import Data.List(nub)
+import Control.Monad(when)
+
 data Network g n e = Network
     { networkNodes      :: !(IntMap.IntMap (Node n)) -- ^ maps node numbers to nodes
     , networkEdges      :: !(IntMap.IntMap (Edge e)) -- ^ maps edge numbers to edges
@@ -122,12 +131,12 @@
 
 constructEdge :: NodeNr -> PortNr -> NodeNr -> PortNr
                  -> [DoublePoint] -> e -> Edge e
-constructEdge fromNr fromPort toNr toPort via info =
+constructEdge fromNr fromPort toNr toPort via einfo =
     Edge
         { edgeFrom = fromNr
         , edgeTo   = toNr
         , edgeVia  = via
-        , edgeInfo = info
+        , edgeInfo = einfo
         , edgeFromPort = fromPort
         , edgeToPort   = toPort
         }
@@ -166,18 +175,18 @@
 setEdgeVia via edge = edge { edgeVia = via }
 
 setEdgeInfo :: e -> Edge oldInfo -> Edge e
-setEdgeInfo info edge = edge { edgeInfo = info }
+setEdgeInfo einfo edge = edge { edgeInfo = einfo }
 
 constructNode :: (InfoKind n g) =>
                  String -> DoublePoint -> Bool
                  -> Either String Shape.Shape -> n -> Maybe (PortNr,PortNr) -> Node n
-constructNode name position nameAbove shape info arity =
+constructNode name position nameAbove shape ninfo arity =
     Node
         { nodeName      = name
         , nodePosition  = position
         , nodeNameAbove = nameAbove
         , nodeShape     = shape
-        , nodeInfo      = info
+        , nodeInfo      = ninfo
         , nodeArity     = arity
         }
 
@@ -218,8 +227,8 @@
 getNodeInfo network nodeNr = nodeInfo (networkNodes network IntMap.! nodeNr)
 
 setNodeInfo :: NodeNr -> n -> Network g n e -> Network g n e
-setNodeInfo nodeNr info network =
-    network { networkNodes = IntMap.insert nodeNr (node { nodeInfo = info }) (networkNodes network) }
+setNodeInfo nodeNr ninfo network =
+    network { networkNodes = IntMap.insert nodeNr (node { nodeInfo = ninfo }) (networkNodes network) }
   where node = networkNodes network IntMap.! nodeNr
 
 getNodeArity :: Network g n e -> NodeNr -> Maybe (PortNr,PortNr)
@@ -264,7 +273,7 @@
 setPosition position node = node { nodePosition = position }
 
 setInfo :: a -> Node a -> Node a
-setInfo info node = node { nodeInfo = info }
+setInfo ninfo node = node { nodeInfo = ninfo }
 
 setArity :: Maybe (PortNr,PortNr) -> Node a -> Node a
 setArity arity node = node { nodeArity = arity }
@@ -430,13 +439,13 @@
              String -> DoublePoint -> Bool -> Either String Shape.Shape -> n
              -> Maybe (PortNr,PortNr)
              -> Network g n e -> (NodeNr, Network g n e)
-addNodeEx name position labelAbove shape info arity network =
+addNodeEx name position labelAbove shape ninfo arity network =
     ( nodeNr
     , network { networkNodes = IntMap.insert nodeNr node (networkNodes network) }
     )
   where
     nodeNr = getUnusedNodeNr network
-    node = constructNode name position labelAbove shape info arity
+    node = constructNode name position labelAbove shape ninfo arity
 
 
 -- | Add an edge to the network.
@@ -544,7 +553,7 @@
 setCanvasSize canvasSize network = network { networkCanvasSize = canvasSize }
 
 setGlobalInfo :: g -> Network g n e -> Network g n e
-setGlobalInfo info network = network { networkInfo = info }
+setGlobalInfo ninfo network = network { networkInfo = ninfo }
 
 {-----------------------------------
   Local functions
@@ -577,3 +586,231 @@
                   IntMap.adjust (\e-> e { edgeVia = take viaNr (edgeVia e)
                                              ++[v]++drop (viaNr+1) (edgeVia e) })
                          edgeNr (networkEdges network) }
+
+-- ---------------------------------------------------------------------
+-- Orphan instances moved from NetworkFile
+
+instance (XML.HTypeable g, XML.HTypeable n, XML.HTypeable e)
+         => XML.HTypeable (Network g n e) where
+    toHType _ = XML.Defined "Network" [] [XML.Constr "Network" [] []]
+ -- toHType g = Defined "Network" [] [Constr "Network" []
+ --			[ Tagged "Width" [String]
+ --			, Tagged "Height" [String]
+ --			, toHType (getGlobalInfo g)
+ --			, toHType (getPalette g)
+ --			, toHType (getNodeAssocs g)
+ --			, toHType (getEdgeAssocs g)
+ --			]]
+instance (InfoKind n g, InfoKind e g, XML.XmlContent g) =>
+         XML.XmlContent (Network g n e) where
+    toContents network =
+        [XML.CElem (XML.Elem (N "Network") []
+                   [ simpleString  "Width"     (show width)
+                   , simpleString  "Height"    (show height)
+                   , makeTag       "Info"      (XML.toContents netInfo)
+                   , makeTag       "Palette"   (XML.toContents (getPalette network))
+                   , makeTag       "Nodes"     (concatMap XML.toContents nodeAssocs)
+                   , makeTag       "Edges"     (concatMap XML.toContents edgeAssocs)
+                   ]) () ]
+      where
+        nodeAssocs = map (uncurry AssocN) $ getNodeAssocs network
+        edgeAssocs = map (uncurry AssocE) $ getEdgeAssocs network
+        (width, height) = getCanvasSize network
+        netInfo = getGlobalInfo network
+    parseContents = do
+        { XML.inElement "Network" $ do
+              { w  <- XML.inElement "Width"  $ fmap read XML.text
+              ; h  <- XML.inElement "Height" $ fmap read XML.text
+              ; i  <- XML.inElement "Info"   $ XML.parseContents
+              ; p  <- XML.inElement "Palette"$ XML.parseContents
+              ; ns <- XML.inElement "Nodes"  $ XML.many1 XML.parseContents
+              ; es <- XML.inElement "Edges"  $ XML.many1 XML.parseContents
+              ; networkValid ns es
+              ; return ( setCanvasSize (w,h)
+                       . setPalette p
+                       . setNodeAssocs (map deAssocN ns)
+                       . setEdgeAssocs (map deAssocE es)
+                       $ empty i undefined undefined)
+              }
+        }
+
+
+peekAttributes :: String -> XML.XMLParser [(QName,AttValue)]
+peekAttributes t =
+    do{ (p, e@(Elem _ as _)) <- XML.posnElement [t]
+      ; XML.reparse [CElem e p]
+      ; return as
+      --; return fmap (\(N a,[Right v]) -> (a,v)) as
+      }
+
+instance XML.HTypeable (AssocN n) where
+    toHType _ = XML.Defined "Node" [] [XML.Constr "Node" [] []]
+instance (InfoKind n g) => XML.XmlContent (AssocN n) where
+    toContents (AssocN n node) =
+        concatMap (replaceAttrs [("id",'N':show n)]) (XML.toContents node)
+    parseContents = do
+        { [(N "id",n)] <- peekAttributes "Node"
+        ; n' <- num n
+        ; node <- XML.parseContents
+        ; return (AssocN n' node)
+        }
+      where num (AttValue [Left ('N':n)]) = return (read n)
+            num (AttValue s) = fail ("Problem reading Node ID: "++verbatim s)
+
+instance XML.HTypeable (AssocE e) where
+    toHType _ = XML.Defined "Edge" [] [XML.Constr "Edge" [] []]
+instance (InfoKind e g) => XML.XmlContent (AssocE e) where
+    toContents (AssocE n edge) =
+        concatMap (replaceAttrs [("id",'E':show n)]) (XML.toContents edge)
+    parseContents = do
+        { [(N "id",n)] <- peekAttributes "Edge"
+        ; n' <- num n
+        ; edge <- XML.parseContents
+        ; return (AssocE n' edge)
+        }
+      where num (AttValue [Left ('E':n)]) = return (read n)
+            num (AttValue s) = fail ("Problem reading Edge ID: "++verbatim s)
+
+instance XML.HTypeable (Node n) where
+    toHType _ = XML.Defined "Node" [] [XML.Constr "Node" [] []]
+instance (InfoKind n g) => XML.XmlContent (Node n) where
+    toContents node =
+        [ makeTag "Node"
+            (XML.toContents (getPosition node) ++
+            [ escapeString "Name"       (getName node)
+            , simpleString "LabelAbove" (show (getNameAbove node))
+            , makeTag      "Shape"      (XML.toContents (getShape node))
+            , makeTag      "Info"       (XML.toContents (getInfo node))
+            , makeTag      "Arity"      (XML.toContents (getArity node))
+            ])
+        ]
+    parseContents = do
+        { XML.inElement "Node" $ do
+              { p <- XML.parseContents	-- position
+              ; n <- XML.inElement "Name" $ XML.text
+              ; a <- XML.inElement "LabelAbove" $ fmap read XML.text
+              ; s <- XML.inElement "Shape" $ XML.parseContents
+              ; i <- XML.inElement "Info" $ XML.parseContents
+              ; r <- (XML.inElement "Arity" $ XML.parseContents)
+                       `XML.onFail` (return Nothing)
+              ; return (constructNode n p a s i r)
+              }
+        }
+{-
+instance XML.HTypeable DoublePoint where
+    toHType _ = XML.Defined "DoublePoint" [] [XML.Constr "X" [] [], XML.Constr "Y" [] []]
+instance XML.XmlContent DoublePoint where
+    toContents (DoublePoint x y) =
+        [ simpleString "X"          (show x)
+        , simpleString "Y"          (show y)
+        ]
+    parseContents = do
+        { x <- XML.inElement "X" $ fmap read XML.text
+        ; y <- XML.inElement "Y" $ fmap read XML.text
+        ; return (DoublePoint x y)
+        }
+-}
+instance XML.HTypeable (Edge e) where
+    toHType _ = XML.Defined "Edge" [] [XML.Constr "Edge" [] []]
+instance InfoKind e g => XML.XmlContent (Edge e) where
+    toContents edge =
+        [ makeTag "Edge"
+            [ simpleString  "From"      (show (getEdgeFrom edge))
+            , simpleString  "To"        (show (getEdgeTo edge))
+            , makeTag       "Via"       (concatMap XML.toContents (getEdgeVia edge))
+            , makeTag       "Info"      (XML.toContents (getEdgeInfo edge))
+            , makeTag       "FromPort"  (XML.toContents (getEdgeFromPort edge))
+            , makeTag       "ToPort"    (XML.toContents (getEdgeToPort edge))
+            ]
+        ]
+    parseContents = do
+        { XML.inElement "Edge" $ do
+              { f <- XML.inElement "From" $ fmap read XML.text
+              ; t <- XML.inElement "To" $ fmap read XML.text
+              ; v <- XML.inElement "Via" $ XML.many XML.parseContents
+              ; i <- XML.inElement "Info" $ XML.parseContents
+              ; fp <- (XML.inElement "FromPort" $ XML.parseContents)
+                          `XML.onFail` (return 0)
+              ; tp <- (XML.inElement "ToPort" $ XML.parseContents)
+                          `XML.onFail` (return 0)
+              ; return (constructEdge f fp t tp v i)
+              }
+        }
+
+---------------------------------------------------------
+-- Internal type isomorphic to (index,value) pairs
+-- (but permits instances of classes)
+---------------------------------------------------------
+data AssocN n = AssocN Int (Node n)
+deAssocN :: AssocN n -> (Int,Node n)
+deAssocN (AssocN n v) = (n,v)
+data AssocE e = AssocE Int (Edge e)
+deAssocE :: AssocE e -> (Int,Edge e)
+deAssocE (AssocE n v) = (n,v)
+
+---------------------------------------------------------
+-- Check whether the network read from file is valid
+---------------------------------------------------------
+
+networkValid :: [AssocN n] -> [AssocE e] -> XML.XMLParser ()
+networkValid nodeAssocs edgeAssocs
+    | containsDuplicates nodeNrs =
+        fail "Node numbers should be unique"
+    | containsDuplicates edgeNrs =
+        fail "Edge numbers should be unique"
+    | otherwise =
+          do{ mapM_ (checkEdge nodeNrs) edgeAssocs
+            ; -- determine whether there are multiple edges between any two nodes
+            ; let multipleEdges = duplicatesBy betweenSameNodes edges
+            ; when (not (null multipleEdges)) $
+                fail $ "There are multiple edges between the following node pairs: " ++
+                    commasAnd [ "(" ++ show (getEdgeFrom e) ++ ", "
+                                    ++ show (getEdgeTo e) ++ ")"
+                              | e <- multipleEdges
+                              ]
+            ; return ()
+            }
+  where
+    nodeNrs = map (fst . deAssocN) nodeAssocs
+    (edgeNrs, edges) = unzip (map deAssocE edgeAssocs)
+
+-- Check whether edges refer to existing node numbers and whether
+-- there are no edges that start and end in the same node
+checkEdge :: [NodeNr] -> AssocE e -> XML.XMLParser ()
+checkEdge nodeNrs (AssocE edgeNr edge)
+    | fromNr == toNr =
+        fail $ "Edge " ++ show edgeNr ++ ": from-node and to-node are the same"
+    | fromNr `notElem` nodeNrs = nonExistingNode fromNr
+    | toNr   `notElem` nodeNrs = nonExistingNode toNr
+    | otherwise                = return ()
+  where
+    fromNr = getEdgeFrom edge
+    toNr   = getEdgeTo   edge
+    nonExistingNode nodeNr =
+        fail $ "Edge " ++ show edgeNr ++ ": refers to non-existing node "
+               ++ show nodeNr
+
+containsDuplicates :: Eq a => [a] -> Bool
+containsDuplicates xs = length (nub xs) /= length xs
+
+-- Partial equality on edges
+betweenSameNodes :: Edge e -> Edge e -> Bool
+betweenSameNodes e1 e2 =
+    (getEdgeFrom e1 == getEdgeFrom e2  &&  getEdgeTo e1 == getEdgeTo e2)
+    ||
+    (getEdgeFrom e1 == getEdgeTo e2    &&  getEdgeTo e1 == getEdgeFrom e1)
+
+-- Returns elements that appear more than once in a list
+duplicates :: Eq a => [a] -> [a]
+duplicates [] = []
+duplicates (x:xs)
+    | x `elem` xs = x : duplicates (filter (/= x) xs)
+    | otherwise   = duplicates xs
+
+-- Returns elements that appear more than once in a list, using given Eq op
+duplicatesBy :: (a->a->Bool) -> [a] -> [a]
+duplicatesBy _  [] = []
+duplicatesBy eq (x:xs)
+    | any (eq x) xs = x : duplicatesBy eq (filter (not . eq x) xs)
+    | otherwise     = duplicatesBy eq xs
+
diff --git a/src/Graphics/Blobs/NetworkControl.hs b/src/Graphics/Blobs/NetworkControl.hs
--- a/src/Graphics/Blobs/NetworkControl.hs
+++ b/src/Graphics/Blobs/NetworkControl.hs
@@ -10,7 +10,7 @@
     , deleteSelection
     , changeNamePosition
     , changeNodeShape
-    , renameNode, reinfoNodeOrEdge
+    , renameNode, reinfoNodeOrEdge, reinfoNodeOrEdgeUser
     , reArityNode
     , changeGlobalInfo
     ) where
@@ -28,10 +28,9 @@
 import Graphics.Blobs.InfoKind
 import Graphics.Blobs.Palette (shapes)
 import Text.Parse
-import Char (isSpace)
+import Data.Char (isSpace)
 
 import Graphics.UI.WX hiding (Selection)
-import Graphics.UI.WXCore
 
 changeNamePosition :: Bool -> State g n e -> IO ()
 changeNamePosition above state =
@@ -259,10 +258,10 @@
 
 selectMultiple :: Maybe (DoublePoint,DoublePoint) -> [Int] -> [(Int,Int)]
                   -> State g n e -> IO ()
-selectMultiple area nodeNrs viaNrs state =
+selectMultiple areaRect nodeNrs viaNrs state =
   do{ pDoc <- getDocument state
     ; PD.superficialUpdateDocument
-              (setSelection (MultipleSelection area nodeNrs viaNrs))
+              (setSelection (MultipleSelection areaRect nodeNrs viaNrs))
               pDoc
     ; repaintAll state
     }
@@ -278,9 +277,9 @@
 dragMultiple nodeNrs viaNrs mousePoint canvas state =
   do{ pDoc <- getDocument state
  -- ; doc <- PD.getDocument pDoc
-    ; Just (hasMoved, origin) <- getDragging state
-    ; let offset = mousePoint `subtractDoublePoint` origin
-    ; when (mousePoint /= origin) $
+    ; Just (hasMoved, originPoint) <- getDragging state
+    ; let offset = mousePoint `subtractDoublePoint` originPoint
+    ; when (mousePoint /= originPoint) $
       do{ -- The first time the point is moved we have to remember
           -- the document in the undo history
         ; (if not hasMoved then PD.updateDocument "move control point"
@@ -306,13 +305,13 @@
 
 dropMultiple :: Bool -> [Int] -> [(Int,Int)] -> DoublePoint -> DoublePoint
                 -> State g n e -> IO ()
-dropMultiple hasMoved nodeNrs viaNrs origin mousePoint state =
+dropMultiple hasMoved nodeNrs viaNrs originPoint mousePoint state =
   do{ when hasMoved $
       do{ pDoc <- getDocument state
         ; PD.superficialUpdateDocument
             (updateNetwork
                 (updateMultiple nodeNrs viaNrs
-                                (mousePoint`subtractDoublePoint`origin)))
+                                (mousePoint`subtractDoublePoint`originPoint)))
             pDoc
         }
     ; canvas <- getCanvas state
@@ -332,9 +331,9 @@
 dragArea mousePoint state =
   do{ pDoc <- getDocument state
     ; doc  <- PD.getDocument pDoc
-    ; Just (_, origin) <- getDragging state
-    ; let (ns,vs) = itemsEnclosedWithin mousePoint origin (getNetwork doc)
-    ; selectMultiple (Just (origin,mousePoint)) ns vs state
+    ; Just (_, originPoint) <- getDragging state
+    ; let (ns,vs) = itemsEnclosedWithin mousePoint originPoint (getNetwork doc)
+    ; selectMultiple (Just (originPoint,mousePoint)) ns vs state
     }
   where
     itemsEnclosedWithin p0 p1 network =
@@ -484,30 +483,156 @@
         _ -> return ()
     }
 
-changeGlobalInfo :: (Show g, Parse g, Descriptor g) =>
+reinfoNodeOrEdgeUser :: (InfoKind n g, InfoKind e g) =>
                     Frame () -> State g n e -> IO ()
+reinfoNodeOrEdgeUser theFrame state =
+  do{ pDoc <- getDocument state
+    ; doc <- PD.getDocument pDoc
+    ; let network    = getNetwork doc
+          globalInfo = getGlobalInfo network
+    ; case getSelection doc of
+        NodeSelection nodeNr ->
+          do{ let oldInfo = getNodeInfo network nodeNr
+            ; result <- editDialogWithGlobal theFrame "Edit node info" oldInfo globalInfo
+            -- ; result <- myTextDialog theFrame MultiLine
+            --                          "Edit node info" (show oldInfo) True
+            ; case result of
+              Just newInfo ->
+                do {
+                  case check (getNodeName network nodeNr)
+                       (getGlobalInfo network) newInfo of
+                    [] -> return ()
+                    e  -> errorDialog theFrame "Validity warning"
+                           ("Validity check fails:\n"
+                            ++unlines e)
+                  ; PD.updateDocument "edit node info"
+                        (updateNetwork
+                         (updateNode nodeNr (setInfo newInfo))) pDoc
+                  ; repaintAll state
+                  }
+              Nothing ->
+                return ()
+            }
+        EdgeSelection edgeNr ->
+          do{ let oldInfo = getEdgeInfo (getEdge edgeNr network)
+            ; result <- editDialogWithGlobal theFrame "Edit edge info" oldInfo globalInfo
+            ; ifJust result $ \newInfo ->
+                       do { case check "edge"
+                                       (getGlobalInfo network) newInfo of
+                              [] -> return ()
+                              e  -> errorDialog theFrame "Validity warning"
+                                        ("Validity check fails:\n"
+                                        ++unlines e)
+                          ; PD.updateDocument "edit edge info"
+                              (updateNetwork
+                                (updateEdge edgeNr (setEdgeInfo newInfo))) pDoc
+                          ; repaintAll state
+                          }
+            }
+              {-
+          do{ let oldInfo = getEdgeInfo (getEdge edgeNr network)
+            ; result <- myTextDialog theFrame MultiLine
+                                     "Edit edge info" (show oldInfo) True
+            ; ifJust result $ \newInfo ->
+                  -- do repaintAll state -- Until we sort out the parser
+                  case runParser parse newInfo of
+                    (Right x, s) ->
+                        do{ when (not (null s || all isSpace s)) $
+                                errorDialog theFrame "Edit warning"
+                                      ("Excess text after parsed value."
+                                      ++"\nRemaining text: "++s)
+                          ; case check "edge"
+                                       (getGlobalInfo network) x of
+                              [] -> return ()
+                              e  -> errorDialog theFrame "Validity warning"
+                                        ("Validity check fails:\n"
+                                        ++unlines e)
+                          ; PD.updateDocument "edit edge info"
+                              (updateNetwork
+                                (updateEdge edgeNr (setEdgeInfo x))) pDoc
+                          ; repaintAll state
+                          }
+                    (Left err, s) -> errorDialog theFrame "Edit warning"
+                                          ("Cannot parse entered text."
+                                          ++"\nReason: "++err
+                                          ++"\nRemaining text: "++s)
+            }
+-}
+        _ -> return ()
+    }
+
+-- ---------------------------------------------------------------------
+
+
+editEdgeInfo :: (Show g, Parse g, Descriptor g) =>
+                    Frame () -> String -> g -> IO (Maybe g)
+editEdgeInfo theFrame _title info =
+
+  do{ result <- myTextDialog theFrame MultiLine
+                "Edit edge info" (show info) True
+    ; case result of
+        Just newInfo ->
+          case runParser parse newInfo of
+                    (Right x, s) ->
+                        do{ when (not (null s || all isSpace s)) $
+                                errorDialog theFrame "Edit warning"
+                                      ("Excess text after parsed value."
+                                      ++"\nRemaining text: "++s)
+                          ; return (Just x)
+                          }
+                    (Left err, s) -> do { errorDialog theFrame "Edit warning"
+                                            ("Cannot parse entered text."
+                                            ++"\nReason: "++err
+                                            ++"\nRemaining text: "++s)
+                                        ; return Nothing
+                                        }
+        Nothing -> return Nothing
+
+    }
+
+-- ---------------------------------------------------------------------
+
+changeGlobalInfo :: (Show g, Parse g, Descriptor g, GuiEdit g) =>
+                    Frame () -> State g n e -> IO ()
 changeGlobalInfo theFrame state =
   do{ pDoc <- getDocument state
     ; doc <- PD.getDocument pDoc
     ; let network = getNetwork doc
           info    = getGlobalInfo network
-    ; result <- myTextDialog theFrame MultiLine ("Edit "++descriptor info)
-                             (show info) True
+    -- ; result <- editGlobalInfo theFrame ("Edit "++descriptor info) info
+    ; result <- editDialog theFrame ("Edit "++descriptor info) info
     ; ifJust result $ \newInfo->
-                        --do repaintAll state -- Until we sort out the parser
+                  do {
+                    PD.updateDocument ("edit "++descriptor info)
+                      (updateNetwork (setGlobalInfo newInfo)) pDoc
+                  ; repaintAll state	-- no visible change?
+                  }
+    }
+
+-- ---------------------------------------------------------------------
+
+editGlobalInfo :: (Show g, Parse g, Descriptor g) =>
+                    Frame () -> String -> g -> IO (Maybe g)
+editGlobalInfo theFrame _title info =
+  do{ result <- myTextDialog theFrame MultiLine ("Edit "++descriptor info)
+                             (show info) True
+    ; case result of
+        Just newInfo->
           case runParser parse newInfo of
             (Right x, s) ->
-                do{ when (not (null s || all isSpace s)) $
-                        errorDialog theFrame "Edit warning"
+              do{ when (not (null s || all isSpace s)) $
+                  errorDialog theFrame "Edit warning"
                               ("Excess text after parsed value."
                               ++"\nRemaining text: "++s)
-                  ; PD.updateDocument ("edit "++descriptor info)
-                      (updateNetwork (setGlobalInfo x)) pDoc
-                  ; repaintAll state	-- no visible change?
-                  }
-            (Left err, s) -> errorDialog theFrame "Edit warning"
-                                  ("Cannot parse entered text."
-                                  ++"\nReason: "++err
-                                  ++"\nRemaining text: "++s)
+                ; return (Just x)
+                }
+            (Left err, s) -> do { errorDialog theFrame "Edit warning"
+                                    ("Cannot parse entered text."
+                                     ++"\nReason: "++err
+                                     ++"\nRemaining text: "++s)
+                                ; return Nothing
+                                }
+        Nothing -> return Nothing
     }
 
+-- EOF
diff --git a/src/Graphics/Blobs/NetworkFile.hs b/src/Graphics/Blobs/NetworkFile.hs
--- a/src/Graphics/Blobs/NetworkFile.hs
+++ b/src/Graphics/Blobs/NetworkFile.hs
@@ -2,28 +2,14 @@
 module Graphics.Blobs.NetworkFile where
 
 import qualified Graphics.Blobs.Network as N
-import Graphics.Blobs.Math
-import Graphics.Blobs.Common
-import Graphics.Blobs.Colors
-import Graphics.Blobs.Shape
 import Graphics.Blobs.InfoKind
-import Graphics.Blobs.Palette
 
 import Text.XML.HaXml.Types
-import Text.XML.HaXml.Escape
 import Text.XML.HaXml.Posn (noPos)
 import Text.XML.HaXml.Parse hiding (element)
--- import Text.XML.HaXml.XmlContent as XML
 import Text.XML.HaXml.XmlContent.Haskell as XML
-import Text.XML.HaXml.Combinators (replaceAttrs)
-import Text.XML.HaXml.Verbatim
-import Text.XML.HaXml.TypeMapping (toDTD,toHType)
 import Text.PrettyPrint.HughesPJ
 import qualified Text.XML.HaXml.Pretty as Pretty
-import Char
-import Maybe
-import Monad(when)
-import List(nub,isPrefixOf)
 
 -- | Print the network data structure to an XML text
 toString :: (InfoKind n g, InfoKind e g, XmlContent g) =>
@@ -48,391 +34,4 @@
             case runParser parseContents [CElem e noPos] of
                 (Left err, _) -> Left err  -- secondary (typeful) parse error
                 (Right v, _)  -> Right (v,[],False)
-
-{-
--- non-XML output
-toStringShow :: (Show g, Show n, Show e) => Network g n e -> String
-toStringShow network =
-    show ( getNodeAssocs network
-         , getEdgeAssocs network
-         , getCanvasSize network
-         , getGlobalInfo network
-         )
-
-fromStringShow :: (Read g, InfoKind n g, InfoKind e g) =>
-                  String -> Either String (Network g n e)
-fromStringShow txt =
-    case reads txt of
-        ((tuple,[]):_) ->
-            let (nodeAssocs, edgeAssocs, canvasSize, globalInfo) = tuple
-            in Right ( setNodeAssocs nodeAssocs
-                     . setEdgeAssocs edgeAssocs
-                     . setCanvasSize canvasSize
-                     $ Network.empty globalInfo undefined undefined
-                     )
-        _ -> Left "File is not a Blobs network"
--}
-
----------------------------------------------------------
--- Internal type isomorphic to (index,value) pairs
--- (but permits instances of classes)
----------------------------------------------------------
-data AssocN n = AssocN Int (N.Node n)
-deAssocN :: AssocN n -> (Int,N.Node n)
-deAssocN (AssocN n v) = (n,v)
-data AssocE e = AssocE Int (N.Edge e)
-deAssocE :: AssocE e -> (Int,N.Edge e)
-deAssocE (AssocE n v) = (n,v)
-
----------------------------------------------------------
--- Convert our data type to/from an XML tree
----------------------------------------------------------
-instance (HTypeable g, HTypeable n, HTypeable e)
-         => HTypeable (N.Network g n e) where
-    toHType _ = Defined "Network" [] [Constr "Network" [] []]
- -- toHType g = Defined "Network" [] [Constr "Network" []
- --			[ Tagged "Width" [String]
- --			, Tagged "Height" [String]
- --			, toHType (getGlobalInfo g)
- --			, toHType (getPalette g)
- --			, toHType (getNodeAssocs g)
- --			, toHType (getEdgeAssocs g)
- --			]]
-instance (InfoKind n g, InfoKind e g, XmlContent g) =>
-         XmlContent (N.Network g n e) where
-    toContents network =
-        [CElem (Elem "Network" []
-                   [ simpleString  "Width"     (show width)
-                   , simpleString  "Height"    (show height)
-                   , makeTag       "Info"      (toContents netInfo)
-                   , makeTag       "Palette"   (toContents (N.getPalette network))
-                   , makeTag       "Nodes"     (concatMap toContents nodeAssocs)
-                   , makeTag       "Edges"     (concatMap toContents edgeAssocs)
-                   ]) () ]
-      where
-        nodeAssocs = map (uncurry AssocN) $ N.getNodeAssocs network
-        edgeAssocs = map (uncurry AssocE) $ N.getEdgeAssocs network
-        (width, height) = N.getCanvasSize network
-        netInfo = N.getGlobalInfo network
-    parseContents = do
-        { inElement "Network" $ do
-              { w  <- inElement "Width"  $ fmap read XML.text
-              ; h  <- inElement "Height" $ fmap read XML.text
-              ; i  <- inElement "Info"   $ parseContents
-              ; p  <- inElement "Palette"$ parseContents
-              ; ns <- inElement "Nodes"  $ many1 parseContents
-              ; es <- inElement "Edges"  $ many1 parseContents
-              ; networkValid ns es
-              ; return ( N.setCanvasSize (w,h)
-                       . N.setPalette p
-                       . N.setNodeAssocs (map deAssocN ns)
-                       . N.setEdgeAssocs (map deAssocE es)
-                       $ N.empty i undefined undefined)
-              }
-        }
-
-peekAttributes :: String -> XMLParser [(String,AttValue)]
-peekAttributes t =
-    do{ (p, e@(Elem _ as _)) <- posnElement [t]
-      ; reparse [CElem e p]
-      ; return as
-      }
-
-instance HTypeable (AssocN n) where
-    toHType _ = Defined "Node" [] [Constr "Node" [] []]
-instance (InfoKind n g) => XmlContent (AssocN n) where
-    toContents (AssocN n node) =
-        concatMap (replaceAttrs [("id",'N':show n)]) (toContents node)
-    parseContents = do
-        { [("id",n)] <- peekAttributes "Node"
-        ; n' <- num n
-        ; node <- parseContents
-        ; return (AssocN n' node)
-        }
-      where num (AttValue [Left ('N':n)]) = return (read n)
-            num (AttValue s) = fail ("Problem reading Node ID: "++verbatim s)
-
-instance HTypeable (AssocE e) where
-    toHType _ = Defined "Edge" [] [Constr "Edge" [] []]
-instance (InfoKind e g) => XmlContent (AssocE e) where
-    toContents (AssocE n edge) =
-        concatMap (replaceAttrs [("id",'E':show n)]) (toContents edge)
-    parseContents = do
-        { [("id",n)] <- peekAttributes "Edge"
-        ; n' <- num n
-        ; edge <- parseContents
-        ; return (AssocE n' edge)
-        }
-      where num (AttValue [Left ('E':n)]) = return (read n)
-            num (AttValue s) = fail ("Problem reading Edge ID: "++verbatim s)
-
-instance HTypeable (N.Node n) where
-    toHType _ = Defined "Node" [] [Constr "Node" [] []]
-instance (InfoKind n g) => XmlContent (N.Node n) where
-    toContents node =
-        [ makeTag "Node"
-            (toContents (N.getPosition node) ++
-            [ escapeString "Name"       (N.getName node)
-            , simpleString "LabelAbove" (show (N.getNameAbove node))
-            , makeTag      "Shape"      (toContents (N.getShape node))
-            , makeTag      "Info"       (toContents (N.getInfo node))
-            , makeTag      "Arity"      (toContents (N.getArity node))
-            ])
-        ]
-    parseContents = do
-        { inElement "Node" $ do
-              { p <- parseContents	-- position
-              ; n <- inElement "Name" $ XML.text
-              ; a <- inElement "LabelAbove" $ fmap read XML.text
-              ; s <- inElement "Shape" $ parseContents
-              ; i <- inElement "Info" $ parseContents
-              ; r <- (inElement "Arity" $ parseContents)
-                       `onFail` (return Nothing)
-              ; return (N.constructNode n p a s i r)
-              }
-        }
-
-instance HTypeable DoublePoint where
-    toHType _ = Defined "DoublePoint" [] [Constr "X" [] [], Constr "Y" [] []]
-instance XmlContent DoublePoint where
-    toContents (DoublePoint x y) =
-        [ simpleString "X"          (show x)
-        , simpleString "Y"          (show y)
-        ]
-    parseContents = do
-        { x <- inElement "X" $ fmap read XML.text
-        ; y <- inElement "Y" $ fmap read XML.text
-        ; return (DoublePoint x y)
-        }
-
-instance HTypeable (N.Edge e) where
-    toHType _ = Defined "Edge" [] [Constr "Edge" [] []]
-instance InfoKind e g => XmlContent (N.Edge e) where
-    toContents edge =
-        [ makeTag "Edge"
-            [ simpleString  "From"      (show (N.getEdgeFrom edge))
-            , simpleString  "To"        (show (N.getEdgeTo edge))
-            , makeTag       "Via"       (concatMap toContents (N.getEdgeVia edge))
-            , makeTag       "Info"      (toContents (N.getEdgeInfo edge))
-            , makeTag       "FromPort"  (toContents (N.getEdgeFromPort edge))
-            , makeTag       "ToPort"    (toContents (N.getEdgeToPort edge))
-            ]
-        ]
-    parseContents = do
-        { inElement "Edge" $ do
-              { f <- inElement "From" $ fmap read XML.text
-              ; t <- inElement "To" $ fmap read XML.text
-              ; v <- inElement "Via" $ many parseContents
-              ; i <- inElement "Info" $ parseContents
-              ; fp <- (inElement "FromPort" $ parseContents)
-                          `onFail` (return 0)
-              ; tp <- (inElement "ToPort" $ parseContents)
-                          `onFail` (return 0)
-              ; return (N.constructEdge f fp t tp v i)
-              }
-        }
-
-{- derived by DrIFT -}
-instance HTypeable Colour where
-    toHType v = Defined "Colour" []
-                   [Constr "RGB" [] [toHType aa,toHType ab,toHType ac]]
-      where (RGB aa ab ac) = v
-instance XmlContent Colour where
-    parseContents = do
-        { inElement "RGB" $ do
-              { aa <- parseContents
-              ; ab <- parseContents
-              ; ac <- parseContents
-              ; return (RGB aa ab ac)
-              }
-        }
-    toContents v@(RGB aa ab ac) =
-        [mkElemC (showConstr 0 (toHType v))
-                 (concat [toContents aa, toContents ab, toContents ac])]
-
-{- derived by DrIFT -}
-instance HTypeable Shape where
-    toHType v = Defined "Shape" []
-                    [Constr "Circle" [] [toHType aa,toHType ab]
-                    ,Constr "Polygon" [] [toHType ac,toHType ad]
-                    ,Constr "Lines" [] [toHType ae,toHType af]
-                    ,Constr "Composite" [] [toHType ag]]
-      where
-        (Circle aa ab) = v
-        (Polygon ac ad) = v
-        (Lines ae af) = v
-        (Composite ag) = v
-instance XmlContent Shape where
-    parseContents = do
-        { e@(Elem t _ _) <- element  ["Circle","Polygon","Lines","Composite"]
-        ; case t of
-          _ | "Polygon" `isPrefixOf` t -> interior e $
-                do { ac <- parseContents
-                   ; ad <- parseContents
-                   ; return (Polygon ac ad)
-                   }
-            | "Lines" `isPrefixOf` t -> interior e $
-                do { ae <- parseContents
-                   ; af <- parseContents
-                   ; return (Lines ae af)
-                   }
-            | "Composite" `isPrefixOf` t -> interior e $
-                fmap Composite parseContents
-            | "Circle" `isPrefixOf` t -> interior e $
-                do { aa <- parseContents
-                   ; ab <- parseContents
-                   ; return (Circle aa ab)
-                   }
-        }
-    toContents v@(Circle aa ab) =
-        [mkElemC (showConstr 0 (toHType v)) (concat [toContents aa,
-                                                     toContents ab])]
-    toContents v@(Polygon ac ad) =
-        [mkElemC (showConstr 1 (toHType v)) (concat [toContents ac,
-                                                     toContents ad])]
-    toContents v@(Lines ae af) =
-        [mkElemC (showConstr 2 (toHType v)) (concat [toContents ae,
-                                                     toContents af])]
-    toContents v@(Composite ag) =
-        [mkElemC (showConstr 3 (toHType v)) (toContents ag)]
-
-{- derived by DrIFT -}
-instance HTypeable ShapeStyle where
-    toHType v = Defined "ShapeStyle" []
-                    [Constr "ShapeStyle" [] [toHType aa,toHType ab,toHType ac]]
-      where (ShapeStyle aa ab ac) = v
-instance XmlContent ShapeStyle where
-    parseContents = do
-        { inElement  "ShapeStyle" $ do
-              { aa <- parseContents
-              ; ab <- parseContents
-              ; ac <- parseContents
-              ; return (ShapeStyle aa ab ac)
-              }
-        }
-    toContents v@(ShapeStyle aa ab ac) =
-        [mkElemC (showConstr 0 (toHType v))
-                 (concat [toContents aa, toContents ab, toContents ac])]
-
-{- handwritten -}
-instance HTypeable a => HTypeable (Palette a) where
-    toHType p = Defined "Palette" [toHType a] [Constr "Palette" [] []]
-              where (Palette ((_,(_,Just a)):_)) = p
-instance XmlContent a => XmlContent (Palette a) where
-    toContents (Palette shapes) =
-        [ mkElemC "Palette" (concatMap toContents shapes) ]
-    parseContents = do
-        { inElement "Palette" $ fmap Palette (many1 parseContents) }
-
-{-
-instance XmlContent a => XmlContent (Either String a) where
-  toContents (Left str)    = [ simpleString "ShapeName" (show str) ]
-  toContents (Right shape) = (toContents shape)
-
-  parseContents = do
-    return () -- Need to implement this
--}
----- UTILITY FUNCTIONS
-
--- Abbreviations
-makeTag :: String -> [Content i] -> Content i
-makeTag name children = CElem (Elem name [] children) undefined
-
-tagWithId :: String -> String -> [Content i] -> Content i
-tagWithId name identity children =
-    CElem (Elem name [("id", AttValue [Left identity])] children) undefined
-
--- | A simple string contains no spaces or unsafe characters
-simpleString :: String -> String -> Content i
-simpleString tag value =
-    CElem (Elem tag [] [ CString False value undefined ]) undefined
-
--- | The string value may contain spaces and unsafe characters
-escapeString :: String -> String -> Content i
-escapeString key value =
-    CElem ((if isSafe value then id else escape) $
-             Elem key [] [ CString (any isSpace value) value undefined ])
-          undefined
-  where
-    isSafe cs = all isSafeChar cs
-    isSafeChar c = isAlpha c || isDigit c || c `elem` "- ."
-
-    escape :: Element i -> Element i
-    escape = xmlEscape stdXmlEscaper
-
-comment :: String -> Content i
-comment s = CMisc (Comment (commentEscape s)) undefined
-
--- Replace occurences of "-->" with "==>" in a string so that the string
--- becomes safe for an XML comment
-commentEscape :: String -> String
-commentEscape [] = []
-commentEscape ('-':'-':'>':xs) = "==>" ++ commentEscape xs
-commentEscape (x:xs) = x : commentEscape xs
-
----------------------------------------------------------
--- Check whether the network read from file is valid
----------------------------------------------------------
-
-networkValid :: [AssocN n] -> [AssocE e] -> XMLParser ()
-networkValid nodeAssocs edgeAssocs
-    | containsDuplicates nodeNrs =
-        fail "Node numbers should be unique"
-    | containsDuplicates edgeNrs =
-        fail "Edge numbers should be unique"
-    | otherwise =
-          do{ mapM_ (checkEdge nodeNrs) edgeAssocs
-            ; -- determine whether there are multiple edges between any two nodes
-            ; let multipleEdges = duplicatesBy betweenSameNodes edges
-            ; when (not (null multipleEdges)) $
-                fail $ "There are multiple edges between the following node pairs: " ++
-                    commasAnd [ "(" ++ show (N.getEdgeFrom e) ++ ", "
-                                    ++ show (N.getEdgeTo e) ++ ")"
-                              | e <- multipleEdges
-                              ]
-            ; return ()
-            }
-  where
-    nodeNrs = map (fst . deAssocN) nodeAssocs
-    (edgeNrs, edges) = unzip (map deAssocE edgeAssocs)
-
--- Check whether edges refer to existing node numbers and whether
--- there are no edges that start and end in the same node
-checkEdge :: [N.NodeNr] -> AssocE e -> XMLParser ()
-checkEdge nodeNrs (AssocE edgeNr edge)
-    | fromNr == toNr =
-        fail $ "Edge " ++ show edgeNr ++ ": from-node and to-node are the same"
-    | fromNr `notElem` nodeNrs = nonExistingNode fromNr
-    | toNr   `notElem` nodeNrs = nonExistingNode toNr
-    | otherwise                = return ()
-  where
-    fromNr = N.getEdgeFrom edge
-    toNr   = N.getEdgeTo   edge
-    nonExistingNode nodeNr =
-        fail $ "Edge " ++ show edgeNr ++ ": refers to non-existing node "
-               ++ show nodeNr
-
-containsDuplicates :: Eq a => [a] -> Bool
-containsDuplicates xs = length (nub xs) /= length xs
-
--- Partial equality on edges
-betweenSameNodes :: N.Edge e -> N.Edge e -> Bool
-betweenSameNodes e1 e2 =
-    (N.getEdgeFrom e1 == N.getEdgeFrom e2  &&  N.getEdgeTo e1 == N.getEdgeTo e2)
-    ||
-    (N.getEdgeFrom e1 == N.getEdgeTo e2    &&  N.getEdgeTo e1 == N.getEdgeFrom e1)
-
--- Returns elements that appear more than once in a list
-duplicates :: Eq a => [a] -> [a]
-duplicates [] = []
-duplicates (x:xs)
-    | x `elem` xs = x : duplicates (filter (/= x) xs)
-    | otherwise   = duplicates xs
-
--- Returns elements that appear more than once in a list, using given Eq op
-duplicatesBy :: (a->a->Bool) -> [a] -> [a]
-duplicatesBy _  [] = []
-duplicatesBy eq (x:xs)
-    | any (eq x) xs = x : duplicatesBy eq (filter (not . eq x) xs)
-    | otherwise     = duplicatesBy eq xs
 
diff --git a/src/Graphics/Blobs/NetworkUI.hs b/src/Graphics/Blobs/NetworkUI.hs
--- a/src/Graphics/Blobs/NetworkUI.hs
+++ b/src/Graphics/Blobs/NetworkUI.hs
@@ -3,30 +3,27 @@
     , getConfig, Config
     ) where
 
-import Graphics.Blobs.GUIEvents
-import Graphics.Blobs.SafetyNet
-import qualified Graphics.Blobs.State as State
-import Graphics.Blobs.StateUtil
-import qualified Graphics.Blobs.Network as Network
-import Graphics.Blobs.NetworkView
-import qualified Graphics.Blobs.NetworkFile as NetworkFile
-import qualified Graphics.Blobs.Document as Document
+
 import Graphics.Blobs.Common
 import Graphics.Blobs.CommonIO
-import qualified Graphics.Blobs.PersistentDocument as PD
-import qualified Graphics.Blobs.PDDefaults as PD
-import Graphics.Blobs.Palette
-import Graphics.Blobs.InfoKind
 import Graphics.Blobs.DisplayOptions
---import Text.XML.HaXml.XmlContent (XmlContent)
-import Text.XML.HaXml.XmlContent.Haskell (XmlContent)
-import Text.Parse
-import Graphics.Blobs.Operations
+import Graphics.Blobs.GUIEvents
+import Graphics.Blobs.InfoKind
 import Graphics.Blobs.NetworkControl (changeGlobalInfo)
-
+import Graphics.Blobs.NetworkView
+import Graphics.Blobs.Operations
+import Graphics.Blobs.SafetyNet
+import Graphics.Blobs.StateUtil
 import Graphics.UI.WX hiding (Child, upKey, downKey)
 import Graphics.UI.WXCore
-import Maybe
+import Text.Parse
+import Text.XML.HaXml.XmlContent.Haskell (XmlContent)
+import qualified Graphics.Blobs.Document as Document
+import qualified Graphics.Blobs.Network as Network
+import qualified Graphics.Blobs.NetworkFile as NetworkFile
+import qualified Graphics.Blobs.PDDefaults as PD
+import qualified Graphics.Blobs.PersistentDocument as PD
+import qualified Graphics.Blobs.State as State
 
 data Config = NFC
     { nfcWinDimensions  :: (Int, Int, Int, Int) -- x, y, width, height
diff --git a/src/Graphics/Blobs/NetworkView.hs b/src/Graphics/Blobs/NetworkView.hs
--- a/src/Graphics/Blobs/NetworkView.hs
+++ b/src/Graphics/Blobs/NetworkView.hs
@@ -11,14 +11,14 @@
 import qualified Graphics.Blobs.Network as Network
 import Graphics.Blobs.Document
 import Graphics.Blobs.Colors
-import Graphics.Blobs.Common
+-- import Graphics.Blobs.Common
 import Graphics.Blobs.Palette
 
 import Graphics.Blobs.Math
 import Graphics.UI.WX as WX hiding (Vector)
 import Graphics.UI.WXCore hiding (Document, screenPPI, Colour)
-import Graphics.UI.WXCore.Draw
-import Maybe
+-- import Graphics.UI.WXCore.Draw
+import Data.Maybe
 import qualified Graphics.Blobs.Shape as Shape
 import Graphics.Blobs.DisplayOptions
 import Graphics.Blobs.InfoKind
@@ -67,7 +67,8 @@
     ; let (width, _height) = Network.getCanvasSize network
     ; when (GlobalInfo `elem` dpShowInfo opt) $
            drawLabel 0 False
-                     (descriptor global++": "++(unwords.lines.show) global)
+                     -- (descriptor global++": "++(unwords.lines.show) global)
+                     (descriptor global)
                      (DoublePoint (width/2) 1) (Justify CentreJ TopJ)
                      [ textColor := wxcolor kNodeLabelColour ]
     -- draw edges, highlight the selected ones (if any)
@@ -126,7 +127,7 @@
                         (justif above) [ textColor := wxcolor kNodeLabelColour ]
 	-- draw info
         ; when (NodeInfo `elem` dpShowInfo opt) $
-              drawLabel (offset (not above)) False (show (Network.getInfo node))
+              drawLabel (offset (not above)) False (descriptor (Network.getInfo node))
                         center (justif (not above))
                         [ textColor := wxcolor kNodeInfoColour ]
         }
@@ -142,10 +143,10 @@
 
     drawLabel :: Double -> Bool -> String -> DoublePoint -> Justify
                  -> [Prop (DC ())] -> IO ()
-    drawLabel voffset boxed text (DoublePoint x y) justify opts =
+    drawLabel voffset isBoxed labelText (DoublePoint x y) justify opts =
       do{ -- draw background
-          when boxed $ do
-            { (textWidth, textHeight) <- logicalGetTextExtent ppi dc text
+          when isBoxed $ do
+            { (textWidth, textHeight) <- logicalGetTextExtent ppi dc labelText
             ; let horizontalMargin = 0.2 -- centimeters
                   verticalMargin = 0.01 -- centimeters
                   topleftY = y+voffset - case justify of
@@ -158,8 +159,8 @@
                 (textWidth+2*horizontalMargin) (textHeight+2*verticalMargin)
                 (solidFill labelBackgroundColor)
             }
-        -- draw text
-        ; logicalText ppi dc (DoublePoint x (y+voffset)) text justify opts
+        -- draw labelText
+        ; logicalText ppi dc (DoublePoint x (y+voffset)) labelText justify opts
         }
 
     drawEdge :: InfoKind e g => Network.Edge e -> [Prop (DC ())] -> IO ()
@@ -171,7 +172,7 @@
         ; when (EdgeInfo `elem` dpShowInfo opt) $
            -- logicalTextRotated ppi dc (middle via) (show info) 45
            --           [ textColor := wxcolor kEdgeInfoColour ]
-              drawLabel 0 False (show (Network.getEdgeInfo edge)) (middle via)
+              drawLabel 0 False (descriptor (Network.getEdgeInfo edge)) (middle via)
                         (Justify CentreJ BottomJ)
                         [ textColor := wxcolor kEdgeInfoColour ]
         }
@@ -185,7 +186,7 @@
 
         fstEdgeVector = (head (via++[toPoint]))
                              `subtractDoublePointVector` fromPoint
-        fstTotalLen   = vectorLength fstEdgeVector
+        -- fstTotalLen   = vectorLength fstEdgeVector
         fstAngle      = vectorAngle fstEdgeVector
 
         penultimatePt = head (reverse (fromPoint:via))
@@ -206,8 +207,8 @@
 
     drawVia :: Network.Edge e -> Network.ViaNr -> [Prop (DC ())] -> IO ()
     drawVia e n options =
-        let pt = (Network.getEdgeVia e)!!n in
-        do logicalCircle ppi dc pt kEDGE_CLICK_RANGE
+        let centrePoint = (Network.getEdgeVia e)!!n in
+        do logicalCircle ppi dc centrePoint kEDGE_CLICK_RANGE
                 (options ++ solidFill violet)
 
 solidFill :: Colour -> [Prop (DC ())]
@@ -245,7 +246,7 @@
         via= Network.getEdgeVia edge
         p  = clickedPoint
         numberedDistancesToSegments = zip [0..] $
-              zipWith (\p0 p1-> distanceSegmentPoint p0 p1 p)
+              zipWith (\pa pb-> distanceSegmentPoint pa pb p)
                       (p0:via) (via++[p1])
     in case [ nr | (nr,dist) <- numberedDistancesToSegments
                  , dist < kEDGE_CLICK_RANGE ] of
@@ -293,20 +294,20 @@
                                    MiddleJ -> (x, y-height/2)
                                    BottomJ -> (x, y-height)
     eachLine _ _ [] = return ()
-    eachLine maxwidth (x,y) (txt:txts) =
-      do{ (w,h) <- logicalGetTextExtent ppi dc txt
-        ; let thisX = case horiz of LeftJ   -> x-maxwidth/2
-                                    CentreJ -> x-w/2
-                                    RightJ  -> x+(maxwidth/2)-w
-        ; drawText dc txt (logicalToScreenPoint ppi (DoublePoint thisX y))
+    eachLine maxwidth (x1,y1) (txt1:txts) =
+      do{ (w,h) <- logicalGetTextExtent ppi dc txt1
+        ; let thisX = case horiz of LeftJ   -> x1-maxwidth/2
+                                    CentreJ -> x1-w/2
+                                    RightJ  -> x1+(maxwidth/2)-w
+        ; drawText dc txt1 (logicalToScreenPoint ppi (DoublePoint thisX y1))
                    options
-        ; eachLine maxwidth (x,y+h) txts
+        ; eachLine maxwidth (x1,y1+h) txts
         }
 
 -- currently assumes only single line of text
-logicalTextRotated :: Size -> DC () -> DoublePoint -> String -> Double
+_logicalTextRotated :: Size -> DC () -> DoublePoint -> String -> Double
                       -> [Prop (DC ())] -> IO ()
-logicalTextRotated ppi dc pos txt angle options =
+_logicalTextRotated ppi dc pos txt angle options =
     draw dc txt (logicalToScreenPoint ppi pos) options
   where
     draw = if angle<1 && angle>(-1) then drawText
diff --git a/src/Graphics/Blobs/Operations.hs b/src/Graphics/Blobs/Operations.hs
--- a/src/Graphics/Blobs/Operations.hs
+++ b/src/Graphics/Blobs/Operations.hs
@@ -1,6 +1,5 @@
 module Graphics.Blobs.Operations where
 
-import Graphics.Blobs.InfoKind
 import Graphics.Blobs.Network
 import Graphics.Blobs.State
 import Graphics.Blobs.Document
diff --git a/src/Graphics/Blobs/PDDefaults.hs b/src/Graphics/Blobs/PDDefaults.hs
--- a/src/Graphics/Blobs/PDDefaults.hs
+++ b/src/Graphics/Blobs/PDDefaults.hs
@@ -73,10 +73,10 @@
             ]
     -- ; set p [ defaultButton := saveB ]
     ; set d [ defaultButton := saveB ]
-    ; showModal d $ \stop ->
-                do set dontsaveB  [on command := stop (Just False) ]
-                   set saveB      [on command := stop (Just True) ]
-                   set cancelB    [on command := stop Nothing ]
+    ; showModal d $ \stop1 ->
+                do set dontsaveB  [on command := stop1 (Just False) ]
+                   set saveB      [on command := stop1 (Just True) ]
+                   set cancelB    [on command := stop1 Nothing ]
     }
 
 defaultSaveAsDialog :: Frame () -> Extensions -> Maybe String -> IO (Maybe String)
diff --git a/src/Graphics/Blobs/Palette.hs b/src/Graphics/Blobs/Palette.hs
--- a/src/Graphics/Blobs/Palette.hs
+++ b/src/Graphics/Blobs/Palette.hs
@@ -1,10 +1,11 @@
 module Graphics.Blobs.Palette where
 
-import List (nub, (\\))
--- import qualified Graphics.Blobs.Shape as Shape
+import Data.List (nub, (\\))
 import qualified Graphics.Blobs.Shape as Shape
 import Text.Parse
 
+import qualified Text.XML.HaXml.XmlContent.Haskell as XML
+
 data Palette a = Palette [ (String, (Shape.Shape, Maybe a)) ]
   deriving (Eq, Show, Read)
 
@@ -22,9 +23,23 @@
 empty = Palette [("circle", (Shape.circle, Nothing))]
 
 instance Functor Palette where
-    fmap _ (Palette p) = Palette (map (\ (n,(s,i))-> (n,(s,Nothing))) p)
+    fmap _ (Palette p) = Palette (map (\ (n,(s,_i))-> (n,(s,Nothing))) p)
 
 
 instance Parse a => Parse (Palette a) where
     parse = do{ isWord "Palette"; fmap Palette $ parse }
+
+
+-- ---------------------------------------------------------------------
+-- orphan instances coming home
+
+{- handwritten -}
+instance XML.HTypeable a => XML.HTypeable (Palette a) where
+    toHType p = XML.Defined "Palette" [XML.toHType a] [XML.Constr "Palette" [] []]
+              where (Palette ((_,(_,Just a)):_)) = p
+instance XML.XmlContent a => XML.XmlContent (Palette a) where
+    toContents (Palette xs) =
+        [ XML.mkElemC "Palette" (concatMap XML.toContents xs) ]
+    parseContents = do
+        { XML.inElement "Palette" $ fmap Palette (XML.many1 XML.parseContents) }
 
diff --git a/src/Graphics/Blobs/PersistentDocument.hs b/src/Graphics/Blobs/PersistentDocument.hs
--- a/src/Graphics/Blobs/PersistentDocument.hs
+++ b/src/Graphics/Blobs/PersistentDocument.hs
@@ -57,7 +57,7 @@
 
 --import IOExts(IORef, newIORef, writeIORef, readIORef)
 import Data.IORef(IORef, newIORef, writeIORef, readIORef)
-import Monad(when)
+import Control.Monad(when)
 
 -- | A persistent document is a mutable variable. This way functions
 --   operating on a document do not have to return the new value but
diff --git a/src/Graphics/Blobs/SafetyNet.hs b/src/Graphics/Blobs/SafetyNet.hs
--- a/src/Graphics/Blobs/SafetyNet.hs
+++ b/src/Graphics/Blobs/SafetyNet.hs
@@ -2,7 +2,7 @@
 
 import Graphics.UI.WX hiding (window)
 import Prelude hiding (catch)
-import Control.Exception (SomeException,Exception,catch)
+import Control.Exception (SomeException,catch)
 
 
 safetyNet :: Window a -> IO b -> IO ()
diff --git a/src/Graphics/Blobs/Shape.hs b/src/Graphics/Blobs/Shape.hs
--- a/src/Graphics/Blobs/Shape.hs
+++ b/src/Graphics/Blobs/Shape.hs
@@ -10,7 +10,7 @@
 import Graphics.Blobs.CommonIO
 import qualified Graphics.UI.WX as WX
 import Graphics.UI.WXCore hiding (Colour)
-import Graphics.UI.WXCore.Draw
+--import Graphics.UI.WXCore.Draw
 import Graphics.Blobs.Math
 import Text.Parse
 --import Text.XML.HaXml.XmlContent
@@ -19,6 +19,10 @@
 import Graphics.Blobs.Colors
 import Graphics.Blobs.Constants
 
+import Text.XML.HaXml.Types
+import qualified Text.XML.HaXml.XmlContent.Haskell as XML
+import Data.List(isPrefixOf)
+
 data Shape =
     Circle  { shapeStyle :: ShapeStyle, shapeRadius :: Double }
   | Polygon { shapeStyle :: ShapeStyle, shapePerimeter :: [DoublePoint] }
@@ -135,23 +139,24 @@
 -}
 
 logicalDraw :: Size -> DC () -> DoublePoint -> Shape -> [WX.Prop (DC ())] -> IO ()
-logicalDraw ppi dc centre shape options =
+logicalDraw ppi dc centrePoint shape options =
     case shape of
-      Circle {}   -> WX.circle dc (logicalToScreenPoint ppi centre)
+      Circle {}   -> WX.circle dc (logicalToScreenPoint ppi centrePoint)
                                   (logicalToScreenX ppi (shapeRadius shape))
                                   (style2options (shapeStyle shape)++options)
       Polygon {}  -> WX.polygon dc (map (logicalToScreenPoint ppi
-                                             . translate centre)
+                                             . translate centrePoint)
                                           (shapePerimeter shape))
                                    (style2options (shapeStyle shape)++options)
-      Lines {}    -> logicalLineSegments ppi dc (map (translate centre)
+      Lines {}    -> logicalLineSegments ppi dc (map (translate centrePoint)
                                                      (shapePerimeter shape))
                                    (style2options (shapeStyle shape)++options)
-      Composite {}-> mapM_ (\s-> logicalDraw ppi dc centre s options)
+      Composite {}-> mapM_ (\s-> logicalDraw ppi dc centrePoint s options)
                            (shapeSegments shape)
 
 logicalLineSegments :: Size -> DC () -> [DoublePoint] -> [WX.Prop (DC ())] -> IO ()
 logicalLineSegments _   _  [_p]                  _options = return ()
+logicalLineSegments _   _  [  ]                  _options = return ()
 logicalLineSegments ppi dc (fromPoint:toPoint:ps) options =
   do{ WX.line dc (logicalToScreenPoint ppi fromPoint)
               (logicalToScreenPoint ppi toPoint) options
@@ -175,3 +180,71 @@
     ShapeStyle	{ styleStrokeWidth = 1
 		, styleStrokeColour = licorice
 		, styleFill = nodeColor }
+
+-- ---------------------------------------------------------------------
+-- Orphan instances coming home
+
+{- derived by DrIFT -}
+instance XML.HTypeable Shape where
+    toHType v = XML.Defined "Shape" []
+                    [XML.Constr "Circle" [] [XML.toHType aa,XML.toHType ab]
+                    ,XML.Constr "Polygon" [] [XML.toHType ac,XML.toHType ad]
+                    ,XML.Constr "Lines" [] [XML.toHType ae,XML.toHType af]
+                    ,XML.Constr "Composite" [] [XML.toHType ag]]
+      where
+        (Circle aa ab) = v
+        (Polygon ac ad) = v
+        (Lines ae af) = v
+        (Composite ag) = v
+instance XML.XmlContent Shape where
+    parseContents = do
+        { e@(Elem (N t) _ _) <- XML.element  ["Circle","Polygon","Lines","Composite"]
+        ; case t of
+          _ | "Polygon" `isPrefixOf` t -> XML.interior e $
+                do { ac <- XML.parseContents
+                   ; ad <- XML.parseContents
+                   ; return (Polygon ac ad)
+                   }
+            | "Lines" `isPrefixOf` t -> XML.interior e $
+                do { ae <- XML.parseContents
+                   ; af <- XML.parseContents
+                   ; return (Lines ae af)
+                   }
+            | "Composite" `isPrefixOf` t -> XML.interior e $
+                fmap Composite XML.parseContents
+            | "Circle" `isPrefixOf` t -> XML.interior e $
+                do { aa <- XML.parseContents
+                   ; ab <- XML.parseContents
+                   ; return (Circle aa ab)
+                   }
+        }
+    toContents v@(Circle aa ab) =
+        [XML.mkElemC (XML.showConstr 0 (XML.toHType v)) (concat [XML.toContents aa,
+                                                     XML.toContents ab])]
+    toContents v@(Polygon ac ad) =
+        [XML.mkElemC (XML.showConstr 1 (XML.toHType v)) (concat [XML.toContents ac,
+                                                     XML.toContents ad])]
+    toContents v@(Lines ae af) =
+        [XML.mkElemC (XML.showConstr 2 (XML.toHType v)) (concat [XML.toContents ae,
+                                                     XML.toContents af])]
+    toContents v@(Composite ag) =
+        [XML.mkElemC (XML.showConstr 3 (XML.toHType v)) (XML.toContents ag)]
+
+{- derived by DrIFT -}
+instance XML.HTypeable ShapeStyle where
+    toHType v = XML.Defined "ShapeStyle" []
+                    [XML.Constr "ShapeStyle" [] [XML.toHType aa,XML.toHType ab,XML.toHType ac]]
+      where (ShapeStyle aa ab ac) = v
+instance XML.XmlContent ShapeStyle where
+    parseContents = do
+        { XML.inElement  "ShapeStyle" $ do
+              { aa <- XML.parseContents
+              ; ab <- XML.parseContents
+              ; ac <- XML.parseContents
+              ; return (ShapeStyle aa ab ac)
+              }
+        }
+    toContents v@(ShapeStyle aa ab ac) =
+        [XML.mkElemC (XML.showConstr 0 (XML.toHType v))
+                 (concat [XML.toContents aa, XML.toContents ab, XML.toContents ac])]
+
diff --git a/src/Graphics/Blobs/State.hs b/src/Graphics/Blobs/State.hs
--- a/src/Graphics/Blobs/State.hs
+++ b/src/Graphics/Blobs/State.hs
@@ -14,12 +14,13 @@
 
 import Graphics.Blobs.Document
 import Graphics.Blobs.Math
-import qualified Graphics.Blobs.PersistentDocument as PD
-import qualified Graphics.Blobs.DisplayOptions as DisplayOptions
-
 import Graphics.UI.WX
 import Graphics.UI.WXCore hiding (Document, ToolWindow)
+import qualified Graphics.Blobs.DisplayOptions as DisplayOptions
+import qualified Graphics.Blobs.PersistentDocument as PD
 
+-- ---------------------------------------------------------------------
+
 type State g n e = Var (StateRecord g n e)
 
 data StateRecord g n e = St
@@ -28,6 +29,8 @@
     , stNetworkFrame    :: Frame ()
     , stCanvas          :: ScrolledWindow ()
     , stPageSetupDialog :: PageSetupDialog ()
+    -- , stNodeEditDialog  :: (EditDialog n) ()
+    -- , stEdgeEditDialog  :: (EditDialog e) ()
     , stDisplayOptions  :: DisplayOptions.DisplayOptions
     }
 
@@ -49,6 +52,7 @@
         , stDisplayOptions  = DisplayOptions.standard
         })
     }
+
 
 -- Getters
 
diff --git a/src/Graphics/Blobs/StateUtil.hs b/src/Graphics/Blobs/StateUtil.hs
--- a/src/Graphics/Blobs/StateUtil.hs
+++ b/src/Graphics/Blobs/StateUtil.hs
@@ -7,7 +7,7 @@
 import Graphics.Blobs.Common
 import qualified Graphics.Blobs.PersistentDocument as PD
 
-import Maybe
+-- import Maybe
 import Graphics.UI.WX
 
 repaintAll :: State g n e -> IO ()
diff --git a/src/Main.hs b/src/Main.hs
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -2,17 +2,16 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 module Main (main, gain) where
 
-import qualified Graphics.Blobs.NetworkUI as NetworkUI
-import Graphics.UI.WX
-import qualified Graphics.Blobs.State as State
+import Data.List (nub)
+import Data.Maybe (fromJust)
+import Graphics.Blobs.CommonIO
 import Graphics.Blobs.InfoKind
-
 import Graphics.Blobs.Network
 import Graphics.Blobs.Operations
---import IntMap (IntMap)
+import Graphics.UI.WX
 import qualified Data.IntMap as IntMap
-import List (nub)
-import Maybe (fromJust)
+import qualified Graphics.Blobs.NetworkUI as NetworkUI
+import qualified Graphics.Blobs.State as State
 
 main :: IO ()
 main = start $
@@ -31,6 +30,18 @@
 instance InfoKind [Int] () where
     blank = []
     check _ _ _ = []
+
+instance Descriptor [Int] where
+  descriptor xs = {- "[Int]=" ++ -} (show xs)
+
+instance Descriptor Int where
+  descriptor x = "Int=" ++ (show x)
+
+instance GuiGlobalEdit [Int] () where
+  editDialogWithGlobal parentWindow dialogTitle initial global = aTextDialog parentWindow dialogTitle initial
+
+instance GuiGlobalEdit Int () where
+  editDialogWithGlobal parentWindow dialogTitle initial global = aTextDialog parentWindow dialogTitle initial
 
 -- A simple range of operations on a graph network.
 graphOps :: GraphOps () [Int] [Int]