5
$\begingroup$

Suppose I have a notebook filled with many chapters, sections, subsections, subsubsections and so on. Instead of changing the style of each of them manually, is there a clever way to set all or part of them one level up?

What I mean is changing the left to the right. enter image description here

$\endgroup$
  • $\begingroup$ Yes, there is. Now, what this will look like will depend on what you want to do, exactly, which I couldn't entirely get from the question. Can you give an example of the desired behavior? $\endgroup$ – b3m2a1 Nov 23 '18 at 3:53
  • $\begingroup$ @b3m2a1 Thanks. Updated. $\endgroup$ – xiaohuamao Nov 23 '18 at 4:04
5
$\begingroup$

Here's an overkill, but very clean answer:

withHiddenChanges[nb_, expr_] :=
  Internal`WithLocalSettings[
   FrontEndExecute@FrontEnd`NotebookSuspendScreenUpdates[nb],
   expr,
   FrontEndExecute@FrontEnd`NotebookResumeScreenUpdates[nb]
   ];
withHiddenChanges~SetAttributes~HoldRest;
modifySingleCellStyle[cell_, fn_] :=
  With[{nbr = NotebookRead[cell]},
   NotebookWrite[
    cell,
    Replace[nbr, s_String :> fn[s] , 1],
    AutoScroll -> False
    ]
   ];
modifySingleCellStyle[fn_][cell_] :=
  modifySingleCellStyle[cell, fn];
modifyCellStyles[cells_, modFn_] :=

 Module[{pnbs = GroupBy[cells, ParentNotebook]},
  KeyValueMap[
    withHiddenChanges[#, 
      Map[modifySingleCellStyle[modFn], #2]
      ] &, 
    pnbs
    ];
  ]

The sneaky thing I do here is make it so you never see the changes happen. They all happen with notebook updates suspended, so it looks automatic.

If memory isn't an issue, this will be faster:

modifyCellStylesBatch[cells_, fn_] :=

  With[{nbrs = NotebookRead[cells]},
   FrontEndExecute@
    MapThread[
     FrontEnd`NotebookWrite[
       #2,
       Replace[#, s_String :> fn[s] , 1],
       AutoScroll -> False
       ] &,
     {nbrs, cells}
     ]
   ];

Here's an example:

enter image description here

Then we run it (I decided after running the first to change the target style):

enter image description here

Change that Replace to implement the logic you want.

You can also see why I turned off the screen updates by running this:

cd = CreateDocument[ConstantArray[Cell["doopdoop", "Text"], 150]];
Block[{withHiddenChanges = #2 &},
  modifyCellStyles[
   Cells[cd, CellStyle -> "Text"], 
   Replace["Text" -> "Item"]
   ]
  ] // AbsoluteTiming
NotebookClose[cd];

{13.1319, Null}

cd = CreateDocument[ConstantArray[Cell["doopdoop", "Text"], 150]];
modifyCellStyles[
  Cells[cd, CellStyle -> "Text"], 
  Replace["Text" -> "Item"]
  ] // AbsoluteTiming
NotebookClose[cd];

{7.19384, Null}

For the case at hand the batch edits actually work fastest:

cd = CreateDocument[ConstantArray[Cell["doopdoop", "Text"], 150]];
modifyCellStylesBatch[
  Cells[cd, CellStyle -> "Text"], 
  Replace["Text" -> "Item"]
  ] // AbsoluteTiming
NotebookClose[cd];

{3.64923, Null}
| improve this answer | |
$\endgroup$
  • $\begingroup$ Why not cd=CreateDocument[ConstantArray[Cell["doopdoop","Text"],150]]; AbsoluteTiming[NotebookPut[NotebookGet[cd]/.Cell[c_,"Text",o___]:> Cell[c,"Item",o],cd]] ? Takes less than half a second. Sure, this gets slow if the notebook is huge, but in general the Mathematica Kernel is much more efficient in replacing stuff than any FrontEnd (undocumented) tools. $\endgroup$ – Rolf Mertig Nov 23 '18 at 9:31
  • $\begingroup$ That's another option, just not in the vein I prefer to work. The big thing I usually want it something that won't lose my selection and, if possible (it wasn't here), doesn't destroy the CellObject I'm working with. Similarly, the NotebookPut method loses where you were in the notebook. $\endgroup$ – b3m2a1 Nov 23 '18 at 9:42
  • 3
    $\begingroup$ Sure. If only the whole standard FrontEnd would have been written, designed and maintained better. In real-life situations (generating large reports e.g.) it is nearly unusable. $\endgroup$ – Rolf Mertig Nov 23 '18 at 10:34
4
$\begingroup$

Here is another one:

PromoteStyles // ClearAll
PromoteStyles[] := PromoteStyles @ EvaluationNotebook[];
$defaultOrder = {"Title", "Chapter", "Subchapter", "Section", "Subsection", "Subsubsection"}

PromoteStyles[ nb_NotebookObject,  stylesOrder : {__String} : $defaultOrder ] := ( 
  PromoteStyle[nb] @@@ Reverse @ Partition[Reverse@stylesOrder, 2, 1];
);

PromoteStyle[nb_NotebookObject] := Function[{old, new}, PromoteStyle[nb, old, new]]
PromoteStyle[nb_NotebookObject, old_, new_] := Scan[
  ( SelectionMove[#, All, Cell, AutoScroll -> False]
  ; FrontEndTokenExecute[nb, "Style", new]
  ) &
, Cells[nb, CellStyle -> old]
];

And you can run PromoteStyles[] or PromoteStyles@nb

| improve this answer | |
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.