Mathematica: Create a TOC

clsnyder — Mon, 19 May 2008 01:02:46 +0000

TOCForNotebook[] :=
  Module[{nbr, data, cells, nb}, nb = EvaluationNotebook[];
   SetOptions[nb, System`CreateCellID -> True];
   SelectionMove[nb, All, Notebook, AutoScroll -> False];
   NotebookWrite[nb, NotebookRead[nb]];
   NotebookFind[nb, "Section", All, CellStyle];
   nbr = NotebookRead[nb];
   data =
    nbr /. {Cell[x_, "Section", ___, z : (CellID -> w_), ___] :> {x,
        w}};
   cells =
    TextCell[
       Button[TextCell[#[[1]], "Hyperlink"],
        NotebookFind[EvaluationNotebook[], #[[2]], All, CellID],
        Appearance -> "Frameless"], "Text"] & /@ data;
   cells = First[ToBoxes[#]] & /@ cells;
   SelectionMove[EvaluationNotebook[], Before, Notebook,
    AutoScroll -> True];
   NotebookWrite[nb, cells];];
Button["Create a Table of Contents", TOCForNotebook[],
 Background -> Yellow]

C L Snyder » Mathematica

Mathematica: Create a TOC