如何以编程方式获取有关Mathematica中字体选择的信息

Question

如果我评估，例如SystemDialogInput["Color"]并选择一种颜色，例如红色，输出单元格显示RGBColor[1,0,0]。

要查看字体面板，我可以评估FrontEndTokenExecute["FontPanel"]。如果我在某处突出显示某些文本，我可以从FrontEndTokenExecute中显示的系统面板更改突出显示的文本（或单元格）的字体样式。我想知道的是，是否有一种方法可以以编程方式返回所选的字体设置，类似于SystemDialogInput["Color"]返回所选颜色的方式。例如，评估一些代码，包括在系统字体面板中选择字体设置，让我们说在字体面板中手动选择Arial 12pt粗体，

并返回例如

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

我们很清楚我正在谈论这样做，而笔记本中没有突出显示的文字或单元格。其中一个问题似乎是 - 至少在Mac上 - 只有在笔记本中突出显示某些内容时才会选择字体。文档中有一些这样的例子（ref/CurrentValue）：

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

这表明如果CurrentValue的适当参数存在但是“ControlsFontFamily”和“PanelFontFamily”在这种情况下不是正确的参数，则可以得到答案。

还可以以编程方式列出特定计算机上可用的所有字体吗？

修改

@kguler提供了对最后一句和我问题的第二部分的答案 - 这可以用来构建我自己的字体面板。我已经运行了@ Heike的代码并在Mac OS X 10.6.8上使用Mma 8.0.4获得了这个（屏幕抓取）。请注意PropertyValue与ref/PropertyValue的阴影。

Answer 1

我很久以前在MathGroup中找到了这个（但现在我找不到确切的链接）。

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

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

编辑：来源是Wolfram的John Fultz。这是MathGroup链接：V7 FrontEndTokens

编辑2：在Windows上，如果没有突出显示的选择，则默认似乎是在执行命令FrontEndExecute[FrontEndToken["FontPanel"]]后光标移动。默认情况下，它是下一个单元格。在对话框返回后键入的第一个键盘输入使用您在字体对话框中进行的字体选择进行样式设置。所以，如果你执行

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

并开始输入您的字体对话框设置将适用。但是，键盘输入之前的任何鼠标移动都会破坏字体设置。

编辑3：使用Silvia关于使用隐形笔记本的想法，但是在当前笔记本中写入新单元也可以。步骤：将选择移动到已关闭的新单元格，写入内容，调用字体面板，捕获单元格的字体选项，删除单元格以及返回捕获的字体选项：

 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}

使用

 fontPanelReturn[]

给出，（例如）

 {{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"}}

编辑4：如果您更改Silvia的代码以便在调用字体面板对话框之前选择单元格然后捕获单元格的字体选项（而不是笔记本的），则会得到相同的结果：

 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]

Answer 2

也许你可以：

设置一个不可见的nb并在其中放入一个示例文本单元格;

- ＆GT;然后选择单元格;

- ＆GT;使用FrontEndTokenExecute["FontPanel"]格式化它;

- ＆GT;从cellexpression中提取您需要的字体选项;

- ＆GT;将它粘贴到你想要的地方。

---

以下是如何实现这一点：

inputFontSettings[] :=
 Module[
  {doc, opt},
  doc = CreateDocument[TextCell["text"], WindowSelected -> False, Visible -> False];
  SelectionMove[doc, All, Notebook];
  FrontEndTokenExecute[doc, "FontPanel"];
  opt = Options@NotebookRead[doc];
  NotebookClose[doc];
  opt
 ]

请注意，如果使用保留默认字体大小，则不会返回FontSize项。

Answer 3

关于列出所有可用字体的问题......

希望有人会很快使用原生的Mathematica方式获取所有可用字体的列表。在我们等待的时候，这是一种使用Java的方法：

Needs["JLink`"]
LoadJavaClass["java.awt.GraphicsEnvironment"];

fontFamilies[] :=
  JavaBlock @
    java`awt`GraphicsEnvironment`getLocalGraphicsEnvironment[] @ 
      getAvailableFontFamilyNames[]

由于技术差异，Java列表可能与Mathematica列表不完全匹配，但它是一个不错的开始。

Answer 4

我认为文档中心Generalizations & Extentions帮助页面上"FontChooser"下的示例可以满足您的需求。该示例的代码是

Needs["GUIKit`"]

GUIRunModal[
 Widget["Panel", {
   Widget["FontChooser", {
     "showLogicalFonts" -> False,
     PropertyValue[{"chooser", "selectionModel"}, 
      Name -> "fontSelectionModel"], 
     BindEvent[{"fontSelectionModel", "change"},
      Script[updateFont[]]]
     }, Name -> "chooser"],
   Widget["TextField", {"text" -> ""}, Name -> "myTextField"],
   Script[
    fontExpr = {};
    updateFont[] := Module[{newFont},
      newFont = 
       PropertyValue[{"fontSelectionModel", "selectedFont"}];
      fontExpr = {
        FontFamily -> PropertyValue[{newFont, "family"}],
         FontSize -> PropertyValue[{newFont, "size"}], 
        FontWeight -> 
         If[PropertyValue[{newFont, "bold"}], "Bold", "Plain"], 
        FontSlant -> 
         If[PropertyValue[{newFont, "italic"}], "Italic", "Plain"]
        };
      SetPropertyValue[{"myTextField", "text"}, ToString[fontExpr]];
        ];
      ],
   BindEvent["endModal", Script[ fontExpr]]
   }]
 ]