How to preserve the order of terms in the output

Question

Is there a way in which mathematica can preserve the order of operations while it evaluates an expression?, for instance: In my short example

w = f[r,Θ] ;   
lapla12 = -(r/(2 μ)) (1/r D[w/r r, {r, 2}] - 1/r^2 (D[w/r, {Θ, 2}] + Cot[Θ] D[w /r, {Θ, 1}])) // ExpandAll // TraditionalForm

The output that mathematica gave me is

However, I know the real order is

In my real problem, I have more than 100 terms and is quite difficult to me sort all terms to check the results.

EDITED: For instance the first 35 terms in my real expression appears in this order and i would like that they appears in the correct order

I'm using the code from Jens for derivatives formatting purposes.

Here is the code i'm using to obtain the above output.

ClearAll["Global`*"]
SetOptions[$FrontEndSession, PrintingStyleEnvironment -> "Condensed"]
$PrePrint = # /. {Csc[z_] :> 1/Defer@Sin[z], 
     Sec[z_] :> 1/Defer@Cos[z], 
     Cot[z_] :> Defer@Cos[z]/Defer@Sin[z]} &;


Subscript[w, 1] = f[Subscript[r, 1], Subscript[r, 2], α, β, γ, Subscript[Θ, 12]];

Set[J, -(D[Subscript[w, 1], {β, 2}] + 1/Sin[β]^2 (D[Subscript[w, 1], {α, 2}] + 
         D[Subscript[w, 1], {γ, 2}]) + Cot[β] D[Subscript[w, 1], β] - 
      2 Cot[β]/ Sin[β] D[Subscript[w, 1], α, γ])] // TraditionalForm ;

Set[Subscript[a, 1], 2 D[Subscript[w, 1], {β, 2}] + D[Subscript[w, 1], {γ, 2}] + J]
     // TraditionalForm ;

Set[Subscript[a, 2],  2 Cot[β]/ Sin[β] D[Subscript[w, 1], {α, 1}] - (1 + 2 Cot[β]^2) 
    D[Subscript[w, 1], {γ, 1}] - 2/Sin[β] D[Subscript[w, 1], β, α] + 2 Cot[β] 
    D[Subscript[w, 1], β, γ]] // TraditionalForm ;

Set[Subscript[f, 1], 1/(2 Sin[Subscript[Θ, 12]]^2) (-J + Cos[Subscript[Θ, 12]] 
    (Sin[2 γ] Subscript[a, 2] - Cos[2 γ] Subscript[a, 1]) + Sin[Subscript[Θ, 12]]
    (Sin[2 γ] Subscript[a, 1] + Cos[2 γ] Subscript[a, 2])) - D[Subscript[w, 1], 
    Subscript[Θ, 12], γ] - 1/2 Cot[Subscript[Θ, 12]] D[Subscript[w, 1], {γ, 1}] +
    (1/4 - 1/(2 Sin[Subscript[Θ, 12]]^2)) D[Subscript[w, 1], {γ, 2}] 
    ] // ExpandAll // TraditionalForm ;

Set[lapla1, -(1/(2 Subscript[μ, 1])) (1/Subscript[r, 1] D[Subscript[w, 1] 
    Subscript[r, 1], {Subscript[r, 1], 2}] - 1/Subscript[r, 1]^2
    (D[Subscript[w,  1], {Subscript[Θ, 12], 2}] + Cot[Subscript[Θ, 12]] 
    D[Subscript[w, 1], {Subscript[Θ, 12], 1}]) - Subscript[f, 1]/Subscript[r, 1]^2)
    ] // ExpandAll // TraditionalForm

EDITED 2 In this case the correct order is ruled by the expression for lapla1.

where terms in red (radial terms) go first, then terms in purple (internal angular terms), and finally the terms in blue (coupling between the orientational angular terms and the internar angular terms). Blue terms are ruled by the expression for $f_1$ from left to right.

Answer 1

This is a quick possibility:

myExpand[expr_] := Module[{tmp},
  Unprotect[Plus];
  ClearAttributes[Plus, Orderless];
  tmp = HoldForm @@ {Expand[expr] /. a_Plus :> Reverse[a]};
  SetAttributes[Plus, Orderless];
  tmp];

w = f[r, Θ];
lapla12 = -(r/(2 μ)) (1/r D[w/r r, {r, 2}] - 1/r^2 (D[w/r, {Θ, 2}] + 
          Cot[Θ] D[w/r, {Θ, 1}])) // myExpand