Generating graphs interactively (GUI)

You could do create a simple graph editing tool to create a graph from scratch by doing something like this. To add edges you just click and drag.

DynamicModule[{pt1, pt2, ind1, ind2, pts = {}, edges = {}, cedge = {}},
 Manipulate[
  EventHandler[
   Dynamic@Graphics[
     {Line[pts[[#]] & /@ edges],
      cedge, {Red, PointSize[Medium], Point[pts]}}, PlotRange -> 1],
   {"MouseDown" :>
     (pt2 = pt1 = Round[MousePosition["Graphics"], 0.1];
      ind1 = PadRight[Flatten[Position[pts, pt1]], 1, Length[pts] + 1][[1]]),
    "MouseDragged" :>
     (pt2 = Round[MousePosition["Graphics"], 0.1]; 
      cedge = {Gray, Dashed, Line[{pt1, pt2}]}),
    "MouseUp" :>
     (pt2 = Round[MousePosition["Graphics"], 0.1];
      If[ind1 == Length[pts] + 1, AppendTo[pts, pt1]];
      ind2 = PadRight[Flatten[Position[pts, pt2]], 1, Length[pts] + 1][[1]];
      If[ind2 == Length[pts] + 1, AppendTo[pts, pt2]];
      If[ind1 =!= ind2, AppendTo[edges, {ind1, ind2}]];
      cedge = {})}],

  Row[{Button["Paste",
     Print[Graph[Range[Length[pts]], edges, VertexCoordinates -> pts]]],
   Button["Clear", pts = {}; edges = {}]}]]]

Screenshot:

Pasted graph:

This is a bit more complicated, but I did this for a human experiment previously, so why not share it.

The code keeps track of nodes and edges of a graph that can be manipulated:

• new edges can be drawn by dragging the mouse from one node to the other
• edges can be deleted via right-click menu
• nodes can be moved by dragging while holding Ctrl
• node can be deleted via right-click menu
• new nodes can be added via the button above the graph

Known issues: sometimes the arrow indicating the position of the new edge is not displayed, because the EventHandler does not recognize the "MouseDragged" event. Still the edge is created correctly.

Edit

Added definition for Pos as it was a packaged function I forgot to include. Renamed it to firstPosition.

DynamicModule[{
  $MaxNodes = 10, r = .1, range = {-2, 2}, snap = .4,
  defNodes = 5, nodes, nodeList = None, edgeList, nodeCoord, labels,
  selectedEdge, selectedNode, nodePos, tail, tailCoord, headCoord, 
  arrowUp, edgeMenuUp, nodeMenuUp, nodeMenuPos, edgeMenuPos, key,
  reset, update, closestPoint, circleLayout,
  selectEdge, deselectEdge, moveEdge, snapEdge, deleteEdge, 
  reverseEdge, selectNode, moveNode, deselectNode, addNode, 
  deleteNode, firstPosition},


 (* Initialization code *)
firstPosition[list_, case_] := Position[list, case, 1, 1][[1, 1]];

 arrowUp = 
  edgeMenuUp = 
   nodeMenuUp = 
    False;(* switches to indicate if there is interaction with \
arrow/edge menu/node menu *)
 selectedNode = tail = {};


 (* Output *)
 Deploy@EventHandler[
   Column@{
     Row@{Button["Add node", addNode[], ImageSize -> 100], 
       Button["Reset", reset[], ImageSize -> 100], 
       Button["Rearrange", circleLayout[], ImageSize -> 100]},
     Panel[Graphics[
       {

        Dynamic[{
            AbsoluteThickness@1, [email protected],
            EventHandler[
             {If[selectedEdge === #, Darker@Red, Black],

              Dynamic[Arrow[(List @@ #) /. nodeCoord, r], 
               TrackedSymbols :> {nodeCoord}],

              If[edgeMenuUp, 
               Inset[ActionMenu[Dynamic["", (edgeMenuUp = False) &], {
                  "reverse" :> reverseEdge@selectedEdge,

                  "delete" :> (edgeMenuUp = False; 
                    deleteEdge@selectedEdge)
                  }, Appearance -> None, ImageSize -> 20, 
                 AutoAction -> True], edgeMenuPos], {}]},
             {
              {"MouseDown", 2} :> (selectedEdge = #; 
                edgeMenuPos = MousePosition["Graphics", Graphics]; 
                edgeMenuUp = True),
              {"MouseUp", 2} :> (selectedEdge = edgeMenuPos = {}; 
                edgeMenuUp = False)
              }, PassEventsDown -> False, PassEventsUp -> False]
            } & /@ edgeList, 
         TrackedSymbols :> {edgeList, edgeMenuPos, edgeMenuUp, 
           selectedEdge}],


        AbsoluteThickness@1, [email protected],
        Dynamic[If[arrowUp, Arrow[{tailCoord, headCoord}], {}], 
         TrackedSymbols :> {arrowUp, headCoord, tailCoord}],

        EdgeForm@{Black, [email protected]},
        Dynamic[(
          {EventHandler[{
               Dynamic[{

                 If[selectedNode === #, Hue[1, 1, .7], 
                  Hue[.6, .2, .8]],
                 Disk[# /. nodeCoord, r]}, 
                TrackedSymbols :> {selectedNode, nodeCoord}],

               If[nodeMenuUp, 
                Inset[ActionMenu[
                  Dynamic[
                   "", (nodeMenuUp = 
                    False) &], {"delete" :> (nodeMenuUp = False; 
                    deleteNode@selectedNode)}, Appearance -> None, 
                  ImageSize -> 20, AutoAction -> True], 
                 nodeMenuPos], {}]},
              {

               "MouseDown" :> (If[(key = CurrentValue@"ControlKey"), 
                  selectNode@#, selectEdge@#]),
               "MouseDragged" :> (If[key, moveNode[], moveEdge[]]),

               "MouseUp" :> (If[key, deselectNode[], deselectEdge[]]; 
                 key = False),
               {"MouseDown", 2} :> (selectedNode = #; 
                 nodeMenuPos = MousePosition["Graphics", Graphics]; 
                 nodeMenuUp = True),
               {"MouseUp", 2} :> (selectedNode = nodeMenuPos = {}; 
                 nodeMenuUp = False)
               }, PassEventsDown -> False, PassEventsUp -> False],

             Dynamic[
              Style[Text[# /. labels, # /. nodeCoord, 
                Scaled@{-.6, -.6}], Gray, FontFamily -> "Ariel", 15], 
              TrackedSymbols :> {nodeCoord}]
             } & /@ nodeList
          ), 
         TrackedSymbols :> {nodeList, nodeMenuUp, nodeMenuPos(* 
           do NOT put selectedNode here as it disables node movement! \
*)}]
        }
       , PlotRange -> {range, range}, Background -> White, 
       PlotRangePadding -> 0, ImagePadding -> 15, ImageMargins -> 0, 
       AspectRatio -> 1, Axes -> False, Frame -> False, 
       FrameTicks -> All]

      , FrameMargins -> 0, ImageMargins -> 0, 
      ImageSize -> {400, Automatic}]}

   , {{"MouseDown", 2} :> {}}, PassEventsDown -> True],


 Initialization :> (

   (* accepts coordinates in the form: {1 -> Subscript[coord, 1], 
   3 -> Subscript[coord, 3], ...} *)
   closestPoint[pt_List, all_List, d_: Infinity] := Module[{dist},
     dist = EuclideanDistance[pt, #] & /@ (Last /@ all);
     If[Min@dist > d, {}, all[[First@Ordering@dist, 1]]]
     ];
   circleLayout[n_Integer] := 
    N@Table[{Cos[2 \[Pi]/n i], Sin[2 \[Pi]/n i]}, {i, n}];

   selectEdge[node_] := (tail = node; 
     tailCoord = headCoord = node /. nodeCoord; arrowUp = True);
   moveEdge[] := 
    If[tail =!= {}, headCoord = MousePosition["Graphics", Graphics]];
   snapEdge[] := Module[{head, new},
     head = 
      closestPoint[MousePosition["Graphics", Graphics], nodeCoord, 
       snap];
     new = tail \[DirectedEdge] head;
     If[head =!= {} \[And] UnsameQ @@ new \[And] 
       FreeQ[edgeList, new] \[And] FreeQ[edgeList, Reverse@new], 
      edgeList = AppendTo[edgeList, new]]];
   deselectEdge[] := (snapEdge[]; arrowUp = False; 
     tail = tailCoord = headCoord = {});
   deleteEdge[
     edge_] := (edgeList = Delete[edgeList, firstPosition[edgeList, edge]]);
   reverseEdge[edge_] := (edgeList = edgeList /. edge -> Reverse@edge);

   selectNode[node_] := (selectedNode = node; 
     nodePos = firstPosition[First /@ nodeCoord, node]);
   moveNode[] := (If[selectedNode =!= {}, 
      nodeCoord[[nodePos, 2]] = MousePosition["Graphics", Graphics]]);
   deselectNode[] := (selectedNode = nodePos = {});
   deleteNode[n_] := If[nodes > 0,
     nodes = nodes - 1;
     nodeList = DeleteCases[nodeList, n];
     edgeList = DeleteCases[edgeList, _?(MemberQ[#, n] &)];
     nodeCoord = DeleteCases[nodeCoord, _[n, _]];
     ];
   addNode[] := If[nodes < $MaxNodes, Block[{new},
      nodes = nodes + 1;
      new = Min@Complement[Range@$MaxNodes, nodeList];
      nodeList = Append[nodeList, new];
      nodeCoord = Append[nodeCoord, new -> RandomReal[range, 2]];
      ]];

   reset[] := (
     selectedEdge = selectedNode = {};
     labels = 
      Thread[Range@$MaxNodes -> 
        Take[CharacterRange["A", "Z"], $MaxNodes]];
     update@defNodes;
     );

   update[n_] := (
     nodes = n;
     nodeList = Range@nodes;
     nodeCoord = Thread[nodeList -> circleLayout@nodes];
     edgeList = {};
     );

   reset[];

   )]

Perhaps Something like this:

Manipulate[
 Graph[{1 \[UndirectedEdge] 2, 2 \[UndirectedEdge] 3, 
   3 \[UndirectedEdge] 1}, VertexCoordinates -> {p1, p2, p3}, 
  PlotRange -> 1], 
 {{p1, {1, 1}}, Locator},
 {{p2, {0, 1}}, Locator},
 {{p3, {1, 0}}, Locator}]

Edit

A little more general:

k =  RandomGraph@{10, 10};
vc = AbsoluteOptions[k, VertexCoordinates] /. HoldPattern[_ -> l_] -> l;

DynamicModule[{pt = vc}, {LocatorPane[Dynamic@pt, 
                                      Dynamic[Subgraph[k, Range@VertexCount@k, 
                                                       VertexCoordinates -> pt]]]}]