Как программно получить информацию о выборе шрифта в Mathematica

Question

Если я оцениваю, например, SystemDialogInput["Color"] и выбираю цвет, скажем, красный, в ячейке вывода отображается RGBColor[1,0,0].

Для просмотра панели шрифтов я могу оценить FrontEndTokenExecute["FontPanel"].Если у меня где-то выделен какой-то текст, я могу изменить стиль шрифта выделенного текста (или ячейки) на системной панели, которая появляется из FrontEndTokenExecute.Мне интересно, есть ли способ программно вернуть выбранные настройки шрифта, аналогично тому, как SystemDialogInput["Color"] возвращает выбранный цвет.Например, оцените некоторый код, который включает в себя выбор настроек шрифта на панели системных шрифтов, скажем, вручную выберите Arial 12pt bold на панели шрифтов,

и верните, например,

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

Просто, чтобы мы поняли, я говорю об этом без какого-либо выделенного текста или ячейки в блокноте.Кажется, одной из проблем, по крайней мере, на Mac, является то, что шрифт выбирается только в том случае, если вы что-то выделили в блокноте.В документации есть несколько подобных примеров (ref/CurrentValue):

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

Это говорит о том, что ответ возможен, если существует соответствующий аргумент для CurrentValue, но «ControlsFontFamily» и «PanelFontFamily» нетправильные аргументы в этом случае.

Также возможно ли программно перечислить все шрифты, доступные на конкретном компьютере?

Редактировать

@ kguler hasпредоставил ответ на последнее предложение и вторую часть моего вопроса - это можно использовать для создания моей собственной панели шрифтов.Я запустил код @ 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.Вот ссылка MathGroup: V7 FrontEndTokens

РЕДАКТИРОВАТЬ 2: В окнах, если у вас нет выделенного выделения, по умолчанию кажется, что курсор перемещается после команды FrontEndExecute[FrontEndToken["FontPanel"]] выполнен.По умолчанию это следующая ячейка.Самая первая клавиатурная запись, которую вы вводите после возврата в диалоге, оформляется с помощью выбора шрифта, который вы делаете в диалоге шрифта.Таким образом, если вы выполните

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

и начнете печатать, настройки вашего шрифта будут применены.Однако любое движение мыши до ввода с клавиатуры нарушает настройки шрифта.

РЕДАКТИРОВАТЬ 3: Использование идеи Сильвии об использовании невидимой записной книжки, но вместо этого запись в новую ячейку в текущей записной книжке также работает.Шаги: Переместите выделение в новую закрытую ячейку, напишите что-нибудь, вызовите панель шрифтов, запишите параметры шрифта ячейки, удалите ячейку и верните захваченные параметры шрифта:

 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: вы получите тот же результат, если вы измените код Сильвии так, что вы выбираете ячейку перед вызовом диалогового окна панели шрифтов изатем захватывает параметры шрифта ячейки (а не записной книжки):

 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"]отформатировать его;

-> извлечь нужные шрифты из cellexpression;

-> вставить его туда, куда вы хотите.

---

Вот как это сделатьthis:

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

Я думаю, что пример под 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]]
   }]
 ] 

Answer 4

По вопросу перечисления всех доступных шрифтов ...

Надеюсь, кто-то скоро присоединится к вам с помощью встроенного в Mathematica способа получить список всех доступных шрифтов. Пока мы ждем, вот способ использования Java:

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

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

Список Java может не совпадать со списком Mathematica с учетом технологических различий, но это неплохое начало.