如何以编程方式获取有关 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 的代码，并在带有 Mma 8.0.4 的 Mac OS X 10.6.8 上得到了这个（屏幕抓取）。注意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 并在其中放置一个示例文本单元；

->然后选择单元格；

-> 使用FrontEndTokenExecute["FontPanel"] 对其进行格式化；

-> 从单元格表达式中提取你需要的字体选项；

-> 将其粘贴到您想要的位置。

---

这是如何实现的：

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

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

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]]
   }]
 ]