How to improve on this Stylesheet Manipulation for Message Styling

Question

The answer by @Kuba changing color of error messages did not seem to work for me (MMA 11.0.1 Win 10 64-bit).

I couldn't work out why and implemented something else that does work for me, but it seems very ugly and I'm sure I could learn much by seeing how others would improve on it.

I think @Kuba's answer should have worked because I created the Default.nb as proposed in $UserBaseDirectory and my stylesheets ultimately inherit from it (Default.nb -> JM Stylsheet -> JM Clearer for TeamViewer).

However, I also directly modified my own stylesheets by using the "enter a style name" box, entering MessageMenuLabel and MessageText and styling them appropriately. The new styles worked and I saved stylesheets but on restarting MMA these styles were gone again.

Finally I wrote this (my 1st attempt to programmatically manipulate style definitions) making further use of @Kuba's answer to this question as follows

(* To preserve the current stylesheet information it has to be
plucked out of the StyleDefinitions; 1st time this is OK as the
StyleDefinitions = just a notebook name, but after adding items it
gets messy and we need to extract the stylesheet notebook name to reapply it.
*)
sdef = CurrentValue[EvaluationNotebook[], StyleDefinitions];
If[! StringQ[sdef], (* 
  this is typically just the filename of a stylesheet notebook, 
  but if it isn't... *)
  sdef = ToString[sdef]; 
  sdef = StringCases[sdef, "StyleDefinitions -> " ~~ __  ~~ ".nb]]", 
    1]; 
  sdef = StringReplace[
    sdef[[1]], {"StyleDefinitions -> " -> "", "]]" -> ""}] 
  ];
SetOptions[EvaluationNotebook[], StyleDefinitions -> Notebook[{
     Cell[StyleData[StyleDefinitions -> sdef]],
     Cell[StyleData["MessageMenuLabel"], Bold, 
      FontColor -> RGBColor[N[174/255], 0.1, 0], 
      FontSize -> 
       CurrentValue[{StyleDefinitions, "Output", "FontSize"}]],
     Cell[StyleData["MessageText"], 
      FontColor -> RGBColor[0.1, 0.1, 0.1]]
     }
    ]
  (* last line needed per Kuba's Programming scripts to create and modify stylesheets answer*)
  /. s_Symbol /; Context[s] === "Global`" :> 
   Symbol["FrontEnd`" <> SymbolName[s]]]  
(* Do something illegal to check the message appearance... *)
1/0

Questions Why might the straightforward approach not have worked, and - for educational purposes - how should it be done programmatically & idiomatically?

Answer 1

I worked on this a while back and found that it was just too messy to really work with the Notebook expression.

Here's a better approach: 1) pull the NotebookObject's stylesheet 2) determine if the cell style you want to edit is in there 3) edit that style or make a new cell to edit

Here's a quick imp for that:

nbStyleSheet[nb_] :=

  With[{cv = CurrentValue[nb, StyleDefinitions]},
   If[! MatchQ[cv, _Notebook], 
    SetOptions[nb,
      StyleDefinitions ->
      Notebook[{Cell[StyleData[StyleDefinitions -> cv]]},
       StyleDefinitions -> "PrivateStylesheetFormatting.nb"
       ]]
    ];
   Lookup[NotebookInformation[nb], "StyleDefinitions"][[1]]
   ];

findStyleData[nb_, 
   stylePattern : _?StringPattern`StringPatternQ : "*"] :=

  Module[{cells = Cells[nb]},
   Association@
    MapThread[
     Replace[
       #,
       {
        Cell[
          StyleData[
           name_String?(StringMatchQ[stylePattern]), ___], ___] :>
         (name -> #2),
        _ -> Nothing
        }
       ] &,
     {
      NotebookRead[cells],
      cells
      }
     ]
   ];

editStyleCell // Clear
editStyleCell[nb_, styleCell_, styleEdits_] :=
 MathLink`CallFrontEnd@{
   FrontEnd`SetOptions[styleCell, styleEdits],
   (* this is a hack to make these edits apply immediately *)

   FrontEnd`SelectionMove[styleCell, All, Cell],
   FrontEndToken[nb, "ToggleShowExpression"],
   FrontEndToken[nb, "ToggleShowExpression"]
   }

makeMissingStyles[nb_, names_] :=
 MathLink`CallFrontEnd@{
   FrontEnd`SelectionMove[nb, After, Notebook],
   FrontEnd`NotebookWrite[nb, Map[Cell[StyleData[#]] &, names]]
   }

styleSheetEdit[notebook_, styleEdits_?AssociationQ] :=
  Module[
   {
    names = Keys[styleEdits],
    nb = nbStyleSheet[notebook],
    cells,
    missing
    },
   cells = findStyleData[nb, Alternatives @@ names];
   missing = Complement[names, Keys@cells];
   If[Length@missing > 0,
    makeMissingStyles[nb, names];
    cells = Join[cells, findStyleData[nb, Alternatives @@ missing]]
    ];
   MapThread[
    editStyleCell[nb, #, #2] &,
    {
     cells,
     styleEdits
     }
    ];
   ];
styleSheetEdit[styleEdits_?AssociationQ] :=      
  styleSheetEdit[EvaluationNotebook[], styleEdits];

Let me know if you have questions. Meantime you can edit notebook stylesheets like this:

styleSheetEdit[<|"Input" -> {FontColor -> Pink}|>]

CurrentValue[EvaluationNotebook[], StyleDefinitions]

Notebook[{Cell[StyleData[StyleDefinitions -> "Default.nb"]], 
  Cell[StyleData["Input"], FontColor -> RGBColor[1, 0.5, 0.5]]}, 
 Visible -> False, 
 FrontEndVersion -> "12.0 for Mac OS X x86 (64-bit) (April 8, 2019)", 
 StyleDefinitions -> "PrivateStylesheetFormatting.nb"]

You can revert changes by setting them to Inherited:

styleSheetEdit[<|"Input" -> {FontColor -> Inherited}|>]