Source

MathEditor / MathEditor / Highlighting.m

(* :Name: MathEditor`Highlighting` *)

(* :Title: Better highlighting for Mathematica. *)

(* :Author: Carlos Cordoba *)

(* :Summary: This package intends to provide a better editor to 
   write programs in Mathematica, using the amazing capabilities to
   manipulate expressions in the kernel, so you don't have to rest
   on other editors (e.g. emacs, vim) to use your favorite all-purpose
   programming language.
*)

(* :Context: MathEditor`Highlighting` *)

(* :Package Version: 1.2 (May 2008) *)

(* :Package Copyright: GNU GPL v2 *)

(* :Copyright: 2012, Carlos Cordoba. *)

(* :Keywords: Highlighting *)

(* :Mathematica Version: 8.0 *)

(* :Limitations:
	1. The last change or edition in the notebook before applying the
        Highlighting is lost due to the formatting of the cell. 
        In the other words, the Undo function is reseted with this package.
        2. It is not possible to do the highlighting in real time.
        3. It doesn't work with the built-in highlighting of the FrontEnd.
*)

(* :Acknowledgments: I wanna give thanks to Jose Luis Moreno and Johanna
   Luna, cause they were the inspiration for this project; to Luc Barthelet
   for his great insight about how a good editor has to be; and to Javier
   Ospina for reporting bugs, being a great listener to all my crazy
   ideas and for his invaluable comments and suggestions.

   Portions of this code are based on Luc Barthelet's button called "Beatiful".
   You can find it at:
   http://groups.google.com.co/group/comp.soft-sys.math.mathematica/browse_thread/
   thread/377a9eb137198e05/41daa2a212e360e9?q=Luc+Barthelet+beautiful&rnum=1&hl=
   es#41daa2a212e360e9
*)

(* :Discussion: *)



BeginPackage["MathEditor`Highlighting`"]

beautifyCell::usage =
"beautifyCell[notebook] highlights the selected cell in
the given notebook"

unbeautifyCell::usage =
"unbeautifyCell[notebook] quits the highlighting of the
selected cell in the given notebook"

beautifyNotebook::usage =
"beautifyNotebook[notebook] highlights all input cells
in the selected notebook"

unbeautifyNotebook::usage =
"unbeautifyNotebook[notebook] quits the highlighting of
all input cells in the selected notebook"

beautifyNotebookInNewNotebook::usage =
"beautifyNotebookInNewNotebook[notebook] highlights the
entire selected notebook in a new one"


Begin["`Private`"]


(* ---------- Scheme of colors -------------- *)

(* textStyle = {FontWeight -> "Bold", FontSize -> 12, FontColor -> textColor, Background -> backgroundColor}; *)

textColor = Black;

backgroundColor = White;

textStyle = {FontColor -> textColor, Background -> backgroundColor};

commentColor = RGBColor[0.133305,0.545106,0.133305];

userSymbolsColor = RGBColor[0.,0.749,1.];

allSymbolsColor = Blue;

specialSymbolColor = Orange;

braceColor = RGBColor[0.,1.,0.498001];

bracketColor = Red;

(* ------------- End of the scheme ----------- *)


coloring[u_, color_] := StyleBox[u, FontColor -> color]

quitStyleBox[expr_] := expr //. StyleBox[h_, ___] -> h

specialSymbols = {"->", "=", "==", "===", ":>", "/.", "//.", "\[Rule]",
                  "\[LeftDoubleBracket]", "\[RightDoubleBracket]"};

prefixSymbols = {"/@", "@@", "@"};

postfixSymbols = {"//"};

beautifyCell =
  Function[nb,
    Block[
      (*Local variables*)
      { 
          userSymbols,
          allSymbols,
          expression,
          expressionWithoutStyle,
          expressionWithNewStyle,
          selectedCell = False,
          coloringSymbols,
          coloringSpecialSymbols,
          coloringComments,
          finalAdjustments,
          $Messages = {}
      },
      
      (* Calculate userSymbols and allSymbols which stand for Mma symbols and symbols loaded by any package *)
      userSymbols = Names["Global`*"];
      allSymbols = Complement[Names["*"], userSymbols];
      
      (* Deciding what to do depending on the kind of selected thing *)
      Which[
         MatchQ[NotebookRead[nb], Cell[__]],
         selectedCell = True,

         MatchQ[NotebookRead[nb], BoxData[__]],
         CompoundExpression[SelectionMove[nb, Next, Word],
                            NotebookWrite[nb, "\[NegativeVeryThinSpace]", None]
         ],

         NotebookRead[nb] == {},
         NotebookWrite[nb, "\[NegativeVeryThinSpace]", None]
      ];

      SelectionMove[nb, All, Cell];
      expression = NotebookRead[nb];

      (* Do the highlighting only if the selected cell is an Input cell *)
      If[
        MatchQ[expression, Cell[__, "Input", ___]],
          
            expressionWithoutStyle = quitStyleBox[expression];
            expressionWithNewStyle = Join[expressionWithoutStyle, Cell@@textStyle];
            
            (* Coloring userSymbols and allSymbols *)
            coloringSymbols =
              expressionWithNewStyle //.
              {
                  {expr_ /; MemberQ[userSymbols,expr], invSp___, "[", hh___, "]", ___}
                  ->
                  {coloring[expr, userSymbolsColor], invSp, "[", hh, "]"},
           
                  {expr_ /; MemberQ[allSymbols, expr], invSp___, "[", hh___, "]", ___}
                  ->
                  {coloring[expr, allSymbolsColor], invSp, "[", hh, "]"}
              };

            (* Coloring prefixed applications *)
            coloringSymbols =
              coloringSymbols //.
              {
                  {expr_ /; MemberQ[userSymbols,expr], invSp___, pS_ /; MemberQ[prefixSymbols, pS], hh__}
                  ->
                  {coloring[expr, userSymbolsColor], invSp, pS, hh},
           
                  {expr_ /; MemberQ[allSymbols, expr], invSp___, pS_ /; MemberQ[prefixSymbols, pS], hh__}
                  ->
                  {coloring[expr, allSymbolsColor], invSp, pS, hh}
           
              };

            (* Coloring postfixed applications *)
            coloringSymbols =
              coloringSymbols //.
              {
                  {hh__, pS_ /; MemberQ[postfixSymbols, pS], invSp1___, expr_ /; MemberQ[userSymbols,expr], invSp2___}
                  ->
                  {hh, pS, invSp1, coloring[expr, userSymbolsColor], invSp2},

                  {hh__, pS_ /; MemberQ[postfixSymbols, pS], invSp1___, expr_ /; MemberQ[allSymbols,expr], invSp2___}
                  ->
                  {hh, pS, invSp1, coloring[expr, allSymbolsColor], invSp2}
           
              };
      
            (* Color allSymbols and userSymbols if the cursor is in the middle of the symbol *)
            coloringSymbols =
              coloringSymbols /. {a_,"\[NegativeVeryThinSpace]", RowBox[{b_, "[", hh___}]} :>
              Which[
                  MemberQ[allSymbols, StringJoin[ToString[a], ToString[b]]],
                  {coloring[a, allSymbolsColor], "\[NegativeVeryThinSpace]", RowBox[{coloring[b, allSymbolsColor], "[", hh}]},
                  
                  MemberQ[userSymbols, StringJoin[ToString[a], ToString[b]]],
                  {coloring[a, userSymbolsColor], "\[NegativeVeryThinSpace]", RowBox[{coloring[b, userSymbolsColor], "[", hh}]},
                  
                  True,
                  {a, "\[NegativeVeryThinSpace]", RowBox[{b, "[", hh}]}
              ];
              
            (* Coloring special symbols *)
            coloringSpecialSymbols =
            coloringSymbols /.
              (
                  Thread[Rule[specialSymbols, coloring[#, specialSymbolColor] & /@ specialSymbols]]
                  ~Join~
                  Thread[Rule[{"{", "}"}, coloring[#, braceColor] & /@ {"{", "}"}]]
                  ~Join~
                  Thread[Rule[{"[", "]"}, coloring[#, bracketColor] & /@ {"[", "]"}]]
              );

            (* Coloring comments *)
            (* Don't erase this part. It generates a conflict with the native highlighting of the FE *)
            coloringComments =
              coloringSpecialSymbols /. RowBox[{"(*", hh___,"*)"}] :>
                coloring[quitStyleBox[RowBox[{"(*", hh, "*)"}]], commentColor];

            (* Doing some final adjustments if the color of a subexpression was changed manually before the HL *)
            finalAdjustments = coloringComments //. RowBox[{h__String}, Opts___] -> RowBox[{StringJoin[h]}, Opts];
            
            (* Writing the colored expression in the notebook *)
            NotebookWrite[nb, finalAdjustments];

            (* Finding the insertion point and deleting it *)
            NotebookFind[nb, "\[NegativeVeryThinSpace]", Previous];
            NotebookDelete[nb];

            (* Selecting back the cell if before applying the button you had the entire cell selected *)
            If[selectedCell, SelectionMove[nb, Previous, Cell]];
            
            ,
            
        (* else *)
          
        (* Finding the insertion point and deleting it, if it was inserted at all *)
        If[NotebookFind[nb, "\[NegativeVeryThinSpace]", Previous] == $Failed,
            Null,
            Null,
            NotebookDelete[nb]
        ]
            
      ]
    ]
  ];


unbeautifyCell =
  Function[nb,
    Block[
      { expression,
        $Messages = {}
      },
    
      SelectionMove[nb, All, Cell];
      expression = quitStyleBox[NotebookRead[nb]];
      expression = expression /. Cell[hh__, "Input", tt___] -> Cell[hh, "Input", tt];
      NotebookWrite[nb, expression];
    ]
  ];


beautifyNotebook =
  Function[nb,
    Block[
      { $Messages = {} },
      
      SelectionMove[nb, Before, Notebook];
      SelectionMove[nb, Next, Cell];
      
      While[
        Not[MatchQ[NotebookRead[nb], {}]],
        If[MatchQ[NotebookRead[nb], Cell[__, "Input", ___]], beautifyCell[nb]];
        SelectionMove[nb, Next, Cell]
      ]
    ]
  ];


unbeautifyNotebook =
  Function[nb,
    Block[
      { $Messages = {} },
      
      SelectionMove[nb, Before, Notebook];
      SelectionMove[nb, Next, Cell];
      
      While[
        Not[MatchQ[NotebookRead[nb], {}]],
        If[MatchQ[NotebookRead[nb], Cell[__, "Input", ___]], unbeautifyCell[nb]];
        SelectionMove[nb, Next, Cell]
      ]
    ]
  ];


beautifyNotebookInNewNotebook =
  Function[nb,
    Block[
      { 
        expression,
        nb1,
        $Messages = {}
      },
      
      SelectionMove[nb, All, Notebook];
      expression = NotebookRead[nb];
      nb1 = NotebookCreate[];
      NotebookWrite[nb1, expression];
      beautifyNotebook[nb1];
    ]
  ];

End[]; (* End `Private` context. *)

(* Protect exported symbols. *)

SetAttributes[
   {beautifyCell, unbeautifyCell, beautifyNotebook, unbeautifyNotebook,
    beautifyNotebookInNewNotebook},
    {Protected, ReadProtected}
];

EndPackage[]; (* End package context. *)