How to programmatically obtain information about font selection in Mathematica

Question

If I evaluate e.g. SystemDialogInput["Color"] and choose a colour, lets say red, the output cell shows RGBColor[1,0,0].

To view the font panel I can evaluate FrontEndTokenExecute["FontPanel"]. If I have some text highlighted somewhere I can change the font styling of the highlighted text (or cell) from the system panel that appears from the FrontEndTokenExecute. What I am wondering is if there is a way to programmatically return the chosen font settings analogous to how SystemDialogInput["Color"] returns the chosen color. For example, evaluate some code that includes choosing font settings within the system font panel, lets say manually choose Arial 12pt bold in the font panel,

enter image description here

and return e.g.

{FontFamily->"Arial",FontSize->12,FontWeight->Bold}

Just so we're clear I'm talking about doing this without any highlighted text or cell in the notebook. One of the problems seems to be -- on a Mac at least -- that the font is only selected if you have highlighted something in the notebook. There are some examples like this in the documentation (ref/CurrentValue):

Style["xxxx", FontFamily :> CurrentValue["ControlsFontFamily"], 
 FontSize :> CurrentValue["ControlsFontSize"]]

This suggest that an answer is possible if the appropriate argument to CurrentValue exists but "ControlsFontFamily" and "PanelFontFamily" are not the right arguments in this case.

Also is it possible to programmatically list all fonts available on a particular computer?

Edit

@kguler has provided an answer to the final sentence and second part of my question -- this could be used to build my own font panel. I have run @Heike's code and got this (screen grab) on Mac OS X 10.6.8 with Mma 8.0.4. Note the shadowing of PropertyValue with ref/PropertyValue.

enter image description here

kglr kglr · Accepted Answer · 2012-01-14T03:43:24

I found this long time ago in MathGroup (but now I cannot find the exact link there).

fontlist = FE`Evaluate[FEPrivate`GetPopupList["MenuListFonts"]]

fontlist /. Rule[x_, y_] -> Style[x, 20, FontFamily -> y]

Mma Fonts

EDIT: The source is Wolfram's John Fultz. Here is the MathGroup link: V7 FrontEndTokens

EDIT 2: On windows, if you don't have a highlighted selection, the default seems to be whereever the cursor moves after the command FrontEndExecute[FrontEndToken["FontPanel"]] is executed. By default it is the next cell. Very first keyboard entry you type after the dialog return is styled with the font selection you make in the font dialog. So, if you execute

SelectionMove[InputNotebook[], After, Notebook]; 
 FrontEndExecute[FrontEndToken["FontPanel"]]

and start typing your font dialog settings will apply. However, any mouse move before a keyboard entry destroys the font settings.

EDIT 3: Using Silvia's idea about using an invisible notebook, but instead writing to a new cell in the current notebook also works. Steps: Move selection to a new cell that is closed, write something, invoke the font panel, capture the font options of the cell, delete the cell, and return the captured font options:

 fontPanelReturn[] := {SelectionMove[EvaluationNotebook[], After, Notebook]; 
   NotebookWrite[EvaluationNotebook[], Cell["text", ShowCellBracket -> False, 
                CellOpen -> False, Magnification -> 0]];
   SelectionMove[EvaluationNotebook[], Before, CellContents]; 
   SelectionMove[EvaluationNotebook[], All, Word]; 
   FrontEndExecute[FrontEndToken["FontPanel"]]; 
  fontops = 
   AbsoluteOptions[
         NotebookSelection[EvaluationNotebook[]], {FontColor, FontFamily, 
        FontProperties, FontSize, FontSlant, FontTracking, 
        FontVariations, FontWeight, Background}];
 NotebookDelete[EvaluationNotebook[]];
 SelectionMove[EvaluationNotebook[], Next, Cell]; fontops}

Using as

 fontPanelReturn[]

gives, (for example)

 {{Background -> None, FontColor -> Automatic, 
   FontFamily -> "Trebuchet MS", 
    FontProperties -> {"FontMonospaced" -> Automatic, 
    "FontSerifed" -> Automatic, "ScreenResolution" -> 72}, 
   FontSize -> 24, FontSlant -> "Italic", FontTracking -> "Plain", 
   FontVariations -> {"CapsType" -> Normal, 
   "CompatibilityType" -> Normal, "Masked" -> False, 
   "Outline" -> False, "RotationAngle" -> 0, "Shadow" -> False, 
   "StrikeThrough" -> False, "Underline" -> False}, 
   FontWeight -> "Bold"}}

EDIT 4: You get the same result if you change Silvia's code so that you select the cell before invoking the font panel dialog and then capturing the cell's font options (rather than the notebook's):

 inputFontSettings[] := 
    Module[{doc, opt}, 
    doc = CreateDocument[TextCell["text"], WindowSelected -> False, Visible -> False]; 
    SelectionMove[doc, Next, Cell]; 
    FrontEndTokenExecute[doc, "FontPanel"]; 
    opt = AbsoluteOptions[
    NotebookSelection[doc], {FontColor, FontFamily, FontProperties, 
    FontSize, FontSlant, FontTracking, FontVariations, FontWeight, 
    Background}]; NotebookClose[doc]; opt]

How to programmatically obtain information about font selection in Mathematica

4 Answers