Creating a tagged, findable, editable front-end object

Question

Often when I'm working in the FE I find myself wishing I could get better access to the actual objects I'm working with. I'll want to manipulate part of an object I built using, say, Framed, but don't have a good way to get it.

Is there a good system for doing this?

Answer 1

I finally built this out. We'll use is Mathematica's BoxID and FE`BoxReference system. You can read about those here. A complete block of packaged up code is available at the end of this answer.

The idea will be to make a wrapper (I called it FENamed) that automatically displays with a BoxID and can be located using FrontEnd`BoxReferenceFind. To do this I used a TemplateBox:

Format[n : 
    FENamed[expr_, obj : feObjectPattern | Automatic : Automatic, 
     name_String, ops : OptionsPattern[]]] :=
  RawBoxes@
   TemplateBox[
    {
     TagBox[ToBoxes[expr], name, BoxID -> name, ops],
     ToBoxes[obj], ToBoxes[name], ToBoxes[Flatten@{ops}]
     },
    "FENamed",
    DisplayFunction -> Function[#],
    InterpretationFunction ->
     Function[
      RowBox[{"FENamed", "[", #[[1]], ",", #2, ",", #3, "," , #4, 
        "]"}]],
    Editable -> True
    ];

Then we make a dispatcher for the BoxReference functions to the TagBox it displays as:

nameBoxApply[
   obj : feObjectPattern | Automatic : Automatic, 
   refOps : _?OptionQ : {},
   name_String, fn_, args___
   ] :=
  MathLink`CallFrontEnd@
   fn[
    FE`BoxReference[
     FE`Evaluate@Replace[obj, Automatic -> FrontEnd`InputNotebook[]],
     {{name}},
     Sequence @@
      DeleteDuplicatesBy[First]@
       Flatten@{
         refOps,
         FE`BoxOffset -> {FE`BoxChild[1]},
         FE`SearchStart -> "StartFromBeginning"
         }
     ],
    args
    ];

Finally we create small number of functions that call this wrapper:

Clear[getNamedObject, selectNamedObject, readNamedObjectContents, 
  replaceNamedObjectContents];
getNamedObject[obj : feObjectPattern | Automatic : Automatic, 
   name_String] :=

  nameBoxApply[obj, name, FrontEnd`BoxReferenceBoxObject];
selectNamedObject[obj : feObjectPattern | Automatic : Automatic, 
   name_String] :=

  nameBoxApply[obj, name, FrontEnd`BoxReferenceFind]; 
readNamedObjectContents[...]

etc.

And then we can define an interface on it via UpValues:

FENamed /:
  BoxObject[
   FENamed[_, obj : feObjectPattern | Automatic : Automatic, 
    name_String, ___]
   ] :=
  getNamedObject[obj, name];
FENamed /:
  NotebookLocate[
   FENamed[_, obj : feObjectPattern | Automatic : Automatic, 
    name_String, ___]
   ] :=
  selectNamedObject[obj, name];
FENamed /:
  NotebookRead[...]

etc.

Then we can package this all up:

BeginPackage["FrontEndNaming`"];
FENamed::usage = "A named object for display in the front end";
Begin["`Private`"];
feObjectPattern =
  _CellObject | _BoxObject | _NotebookObject |
   _FrontEnd`InputNotebook | _FrontEnd`EvaluationNotebook | \
_FrontEnd`ButtonNotebook |
   _FrontEnd`EvaluationCell | _FrontEnd`EvaluationBox | \
_FrontEnd`Self | _FrontEnd`Parent;
FENamed[
   FENamed[expr_, objOld : feObjectPattern | Automatic : Automatic, 
    name_String, ops : OptionsPattern[TagBox]
    ],
   objNew : feObjectPattern | Automatic : Automatic,
   name_String,
   ops2 : OptionsPattern[]
   ] := FENamed[expr, objNew, name, Flatten[{ops2, ops}]];
FENamed[
   expr_,
   obj : feObjectPattern | Automatic : Automatic,
   ops : OptionsPattern[]
   ] := FENamed[expr, obj, CreateUUID[], ops];
Format[n : 
    FENamed[expr_, obj : feObjectPattern | Automatic : Automatic, 
     name_String, ops : OptionsPattern[]]] :=
  RawBoxes@
   TemplateBox[
    {
     TagBox[ToBoxes[expr], name, BoxID -> name, ops],
     ToBoxes[obj], ToBoxes[name], ToBoxes[Flatten@{ops}]
     },
    "FENamed",
    DisplayFunction -> Function[#],
    InterpretationFunction ->
     Function[
      RowBox[{"FENamed", "[", #[[1]], ",", #2, ",", #3, "," , #4, 
        "]"}]],
    Editable -> True
    ];
nameBoxApply // Clear
nameBoxApply[
   obj : feObjectPattern | Automatic : Automatic, 
   refOps : _?OptionQ : {},
   name_String, fn_, args___
   ] :=
  MathLink`CallFrontEnd@
   fn[
    FE`BoxReference[
     FE`Evaluate@Replace[obj, Automatic -> FrontEnd`InputNotebook[]],
     {{name}},
     Sequence @@
      DeleteDuplicatesBy[First]@
       Flatten@{
         refOps,
         FE`BoxOffset -> {FE`BoxChild[1]},
         FE`SearchStart -> "StartFromBeginning"
         }
     ],
    args
    ];
Clear[getNamedObject, selectNamedObject, readNamedObjectContents, 
  replaceNamedObjectContents];
getNamedObject[obj : feObjectPattern | Automatic : Automatic, 
   name_String] :=

  nameBoxApply[obj, name, FrontEnd`BoxReferenceBoxObject];
selectNamedObject[obj : feObjectPattern | Automatic : Automatic, 
   name_String] :=

  nameBoxApply[obj, name, FrontEnd`BoxReferenceFind]; 
readNamedObjectContents[
   obj : feObjectPattern | Automatic : Automatic, name_String] :=

  nameBoxApply[obj, name, FrontEnd`BoxReferenceRead];
replaceNamedObjectContents[
   obj : feObjectPattern | Automatic : Automatic, name_String, 
   boxes_] :=

  nameBoxApply[obj, name, FrontEnd`BoxReferenceReplace, boxes];
getNamedObjectOptions[obj : feObjectPattern | Automatic : Automatic, 
   name_String] :=

  nameBoxApply[obj, FE`BoxOffset -> {FE`BoxParent[1]}, name, 
   FrontEnd`BoxReferenceGetOptions];
getNamedObjectOptions[obj : feObjectPattern | Automatic : Automatic, 
  name_String, opt_?OptionQ] :=

 nameBoxApply[obj, name, FrontEnd`BoxReferenceGetOptions, opt]
setNamedObjectOptions[obj : feObjectPattern | Automatic : Automatic, 
   name_String, boxes_] :=

  nameBoxApply[obj, name, FrontEnd`BoxReferenceSetOptions, boxes];
(* UpValues interface on this *)
FENamed /:
  BoxObject[
   FENamed[_, obj : feObjectPattern | Automatic : Automatic, 
    name_String, ___]
   ] :=
  getNamedObject[obj, name];
FENamed /:
  NotebookLocate[
   FENamed[_, obj : feObjectPattern | Automatic : Automatic, 
    name_String, ___]
   ] :=
  selectNamedObject[obj, name];
FENamed /:
  NotebookRead[
   FENamed[_, obj : feObjectPattern | Automatic : Automatic, 
    name_String, ___]
   ] :=
  readNamedObjectContents[obj, name];
FENamed /:
  NotebookWrite[
   FENamed[_, obj : feObjectPattern | Automatic : Automatic, 
    name_String, ___],
   cnts_
   ] :=
  replaceNamedObjectContents[obj, name, cnts];
FENamed /:
  HoldPattern[
   Options[
    FENamed[_, obj : feObjectPattern | Automatic : Automatic, 
     name_String, ___], 
    opt___
    ]
   ] :=
  getNamedObjectOptions[obj, name, opt];
FENamed /:
  SetOptions[
   FENamed[_, obj : feObjectPattern | Automatic : Automatic, 
    name_String, ___], 
   opt___
   ] :=
  setNamedObjectOptions[obj, name, opt];
End[];
EndPackage[];

And here's it in action:

Panel[
 Column[{
   text = FENamed["This is a chunk of text or something", "text1"],
   "This is other untouched text"
   }]
 ]

BoxObject[text]

BoxObject[120193]

NotebookLocate[text]

True

NotebookWrite[text, ToBoxes@ "This is a new chunk of text"]

NotebookWrite[text, ToBoxes@ "This is yet another chunk of text"]

Note that this works by searching in the InputNotebook, but you can attach any notebook to the FENamed object like,

text2 = FENamed["This is a chunk of text or something", 
  EvaluationNotebook[], "text1"]

And then in a different notebook:

EvaluationNotebook[] === text2[[2]]

False

NotebookRead[text2]

"\"This is a chunk of text or something\""

NotebookWrite[text2, ToBoxes@"asdasd"];
NotebookRead[text2]

"\"asdasd\""

This was pretty quick-and-dirty, so if there are refinements or extensions I should add let me know.