Is it possible to create MakeBoxesStop wrapper?

问题:

It is known that output expressions are passed through MakeBoxes to turn the graphics expressions into the box language which the front end uses to represent graphics (when $Output has default option FormatType->StandardForm). For example, if we evaluate:

HoldComplete[Graphics[Disk[]]]

we get a disk wrapped by HoldComplete:

This is because HoldComplete does not stop MakeBoxes from converting its contents to typeset expression:

In[4]:= MakeBoxes@HoldComplete[Graphics[Disk[]]]
Out[4]= RowBox[{"HoldComplete", "[", GraphicsBox[DiskBox[{0, 0}]], "]"}]

So my question is: is it possible to make some additional definitions to MakeBoxes such that wrapping any expression with head MakeBoxesStop will prevent MakeBoxes from converting this expression to typeset form? In this case the expression should look in output as any other expression with no rules associated with symbols in it; in the above case:

P.S. Please do not suggest to use InputForm since I am not satisfied with its default behavior.

回答1:

This function seems to do it:

Clear[MakeBoxesStop];
MakeBoxesStop /: MakeBoxes[MakeBoxesStop[expr_], form_] :=
  Module[{heldHeads = 
     Join @@ Cases[expr,s_Symbol[___] :> HoldComplete[s], {0, Infinity}, 
      Heads -> True], 
    modified, direct,  tempContext = ToString[Unique[]] <> "`"},
   Block[{$ContextPath = $ContextPath, $Packages  = $Packages},
     BeginPackage[tempContext];
       modified = 
        Join @@ Map[
          Function[head,
             ToExpression[ToLowerCase[ToString[Unevaluated[head]]],InputForm, HoldComplete],     
             HoldAllComplete], 
          heldHeads];
     EndPackage[];
     With[{newexpr = 
       expr /. (List @@ Thread[HoldPattern /@ heldHeads -> modified, HoldComplete])},
       With[{result = 
        MakeBoxes[newexpr, form] /. 
           Thread[Rule @@ 
              Map[List @@ 
                 Map[Function[head, ToString[Unevaluated[head]], HoldAllComplete], #] &,
                 {modified , heldHeads}]]
            },
            Remove @@ Names[tempContext <> "*"];
            result]]]];

It won't win the elegance contests, and may be not very clean, but it seems to do what you requested:

In[270]:= MakeBoxesStop[Graphics[Disk[]]]

Out[270]= Graphics[Disk[List[0, 0]]]

If you don't want expression inside MakeBoxesStop to evaluate, add the appropriate attributes and Unevaluated wrappers in the body.

EDIT

The following simple box-making function is based on the Mathematica parser posted here:

Clear[toBoxes];
toBoxes[expr_] :=
  First[parse[tokenize[ToString@FullForm[expr]]] //. {
    head_String[elem_] :>    RowBox[{head, "[", elem, "]"}], 
    head_String[elems___] :>  RowBox[{head, "[", RowBox[Riffle[{elems}, ","]], "]"}]}]

Then, we need:

Clear[MakeBoxesStopAlt];
MakeBoxesStopAlt /: MakeBoxes[MakeBoxesStopAlt[expr_], form_] :=  toBoxes[expr]

For example:

In[327]:= MakeBoxesStopAlt[Graphics[Disk[]]]

Out[327]= Graphics[Disk[List[0, 0]]]