How to write a drag-n-drop reorderable gui?

Question

Most modern GUI building libraries (e.g. cocoa) support this basic operation in tables or lists: reordering items with a mouse. For example, the drag-and-drop of items in a MacOS finder or app window:

So how would one achieve a basic drag-n-drop reorder with these required features:

1. The operation is smoothly animated (rows move out of the way)
2. Thumbnails are carried along with the mouse
3. Insertion point is highlighted
4. Works in panes that have content longer than the pane's size
5. (optional) Undo works

Code to start with:

The current best solution I've found is from user @jVincent for Grid[], but it lacks all the above properties:

SetAttributes[idTag, Protected]
SetAttributes[idSetter, HoldAll]
idSetter[var_] := Function[{content, id}, EventHandler[content, {"MouseMoved" :> (var = id)}]]

SetAttributes[dragNdrop, HoldFirst]; dragNdrop[content_, action_] := 
 DynamicModule[{currentId, from}, EventHandler[Dynamic[Block[{idTag = idSetter[currentId]}, 
     content]], {"MouseDown" :> (from = currentId), 
    "MouseUp" :> action[from, currentId]}]]

mygrid = {{1, 2, 5, 7, 9}, {3, 4, 8, 4, 2}, {5, 12, 7, 3, 8}};
dragNdrop[Grid[MapIndexed[idTag, mygrid, {2}]], action]

Related:

Now, this question has been asked in parts before, but none of the solutions have all the features of drag-and-drop behavior:

• Drag and Drop Support
• How to make dynamic input fields work with drag & drop
• Arranging elements in a Grid by drag&drop

Answer 1

Here is a very crude first implementation (code at the bottom):

(note that the updated version is called as `dragDropList[Dynamic@l)

Some notes:

• The black box serves both as insertion marker and as spacer to move the other items out of the way - obviously, it will need some better styling
• I'm not sure what the best size for the insertion point is - one option is to make it the same size as the item being moved (not sure how to do that though)
• As you can see, there is no smooth animation - not sure whether this one is feasible with any kind of acceptable performance
• The insertion bar is the item currently being moved - this makes re-insertion very easy, since we just have to change the displayed content back. Also, we never have to add stuff to the list, just reorder it
• The insertion bar is moved every time the cursor is over another item
• As can be seen, there is some flickering in the order of the items at some points - this is caused by the fact that reordering the items can sometimes bring another item below the cursor (instead of the insertion bar), causing repeated reordering
• The state of the control lives in several variables:
  • list: The list of items, in their current order
  • iList: The list of indices, in the same order as list
  • indices: The current positions of the elements (given in the original order)
  • dragged: The index of the currently dragged item, or None
  • curPos: The current position of the insertion bar
  • cursor: The cursor to show (includes the moved item)

BeginPackage["dragDropList`"];
dragDropList;
Begin["`Private`"];
dragDropList[Dynamic@var_, items_] :=
 Panel@DynamicModule[
   {
    set = (var = #) &,
    rawItems = items,
    list,
    iList,
    indices = Range@Length@items,
    dragged = None,
    curPos,
    cursor = "Arrow",
    defCursor = 
     Graphics[{Arrowheads[0.7], Arrow[{{0, 0}, {-.5, 1}}]}, 
      ImageSize -> 16, PlotRange -> {{-1, 0}, {0, 2}}]
    },
   set@rawItems;
   iList = indices;
   list = MapIndexed[
     EventHandler[
         Dynamic@If[
           dragged === #2,

           Graphics[Rectangle[{0, 0}, {1, 1}], AspectRatio -> Full, 
            ImageSize -> {100, 30}],
           #
           ],
         {
          "MouseDown" :> (
            dragged = #2;
            curPos = indices[[dragged]];

            FrontEndExecute[
             FrontEnd`SetMouseAppearance[
              cursor = Overlay[{#, defCursor}, Alignment -> Center]]]
            ),
          "MouseEntered" :> (
            If[curPos =!= indices[[#2]] && dragged =!= None,
             With[
              {newPos = indices[[#2]]},
              {iList, list} = 
               Transpose[({t, d} \[Function] 
                   Insert[d, First@t, newPos]) @@ 
                 TakeDrop[Transpose@{iList, list}, {curPos}]];
              indices = Ordering@iList;
              set@rawItems[[iList]];
              curPos = newPos
              ]
             ]
            )
          }
         ] & @@ {#, #2[[1]]} &,
     rawItems
     ];
   Deploy@EventHandler[
     Pane[
      Dynamic@Column@list,
      {Automatic, Automatic},
      Scrollbars -> Automatic
      ],
     {
      "MouseUp" :> (
        dragged = None;
        FrontEndExecute[
         FrontEnd`SetMouseAppearance[cursor = "Arrow"]]
        ),
      "MouseEntered" :> FrontEndExecute[FrontEnd`SetMouseAppearance[]],
      "MouseExited" :> 
       FrontEndExecute[FrontEnd`SetMouseAppearance[cursor]]
      },
     PassEventsDown -> True
     ]
   ]
End[];
EndPackage[];

Dynamic@list
dragDropList[Dynamic@list,Panel/@Table[RandomWord[],10]]

Answer 2

I once approached this. I never finished it so let me know if you face any issues:

ResourceFunction["GitHubInstall"]["kubapod", "mgui"]
<< MGUI`

And here is an example:

DynamicModule[{ labels = Range[7] }

 , labels[[1]] = Style[1, "Section"]
 ; Grid[{
     { "Default", "ContinuousAction", "", "ref"}
   , { MSorter[Dynamic@labels]
     , MSorter[Dynamic@labels, ContinuousAction -> True]
     , Button["reset", labels = Range[7], ImageSize -> Small]
     , Dynamic@Column[Pane /@ labels]
     }
   }]
 ]

• https://github.com/kubaPod/MGUI

Answer 3

Great work on this post! While I've been under the weather I took your efforts and tried to see if there was a simpler way to achieve the same thing using the properties of the objects themselves vice an indexing scheme to make things a little easier. I don't know how well I did but here is some working code.

R/ Andy

dragDropM[Dynamic@orderedL_, objectL_] := 
DynamicModule[{dynamicL, ddObjectF, grabbed = None, entered = None, 
grabbedPos = {}, enteredPos = {}, set = (orderedL = #) &},
dynamicL = ddObjectF /@ objectL;
set@objectL;
Deploy@EventHandler[
Pane[Dynamic[Column[dynamicL]]
 , ImageSize -> {100, 200}
 , Scrollbars -> True
 ],
{"MouseUp" :> (entered = grabbed = None)}
, PassEventsDown -> True, PassEventsUp -> True
]
, Initialization :> (ddObjectF[object_] :=
 EventHandler[
  Dynamic[
   If[TrueQ[object === grabbed],
    Style[Pane[object, 300], Background -> LightBlue],
    Pane[object, 300]
    ]
   , TrackedSymbols :> {object, grabbed, dynamicL}]
  , {
   "MouseDown" :> (grabbed = object; 
     grabbedPos = Position[dynamicL, grabbed]),
   "MouseEntered" :> (
     entered = object; 
     enteredPos = Position[dynamicL, entered];
     If[
      grabbed =!= entered && grabbed =!= None && entered =!= None,
  dynamicL = 
   ReplacePart[dynamicL, 
    Flatten[{((# -> grabbed) & /@ 
        enteredPos), (# -> entered & /@ grabbedPos)}]];
  entered = grabbed;

  grabbedPos = Position[dynamicL, grabbed];

  set@Table[

    objectL[[SelectFirst[Position[dynamicL, iiObject], 
        Length@# == 6 &][[1]]]]
    , {iiObject, objectL}]

  ]

 )

}
  , PassEventsUp -> False
  ]
)]