Here's a way to use the OS-level Print > Save As PDF mechanism to get proper PDFs out, the only issue is that it's a truly horrible hack:
getPrintNotebookExpr[expr_] :=
Switch[
Head@expr,
Notebook,
expr,
Cell,
getPrintNotebookExpr@Notebook[{expr}],
BoxData,
getPrintNotebookExpr@Cell[expr, "Output"],
TextData,
getPrintNotebookExpr[Cell[expr, "Text"]],
_,
getPrintNotebookExpr[BoxData@ToBoxes@expr]
];
getExprDims[expr_] :=
Rasterize[expr, "RasterSize"];
Options[printPDFExport] =
{
"MediaBoxPadding" -> 3,
"ScratchFile" -> "~/Desktop/fig.pdf",
"BasePageSize" -> {612, 792},
"PrinterPointScaling" -> .72
};
printPDFExport[
pdf_String?(StringEndsQ[#, ".pdf"] &),
expr_,
ops : OptionsPattern[]
] :=
Module[
{
nb = StringReplace[pdf, ".pdf" -> ".nb"],
nbex,
dims,
exists,
nbobj,
targetFile = OptionValue["ScratchFile"],
openR,
str,
openW,
pdfMarginL,
pdfMarginB,
mag = OptionValue["PrinterPointScaling"],
pageSize,
initSize = OptionValue["BasePageSize"],
pageDiff,
boxPad = OptionValue["MediaBoxPadding"]
},
nbex = getPrintNotebookExpr[expr];
dims = getExprDims[expr];
exists = FileExistsQ@nb;
pageSize = mag*dims;
pageDiff = initSize - pageSize;
{pdfMarginL, pdfMarginB} = Floor[pageDiff/2];
nbobj =
CreateDocument[nbex,
{
Visible -> False,
WindowSize -> dims,
PrintingOptions -> {
"FirstPageFooter" -> False,
"FirstPageHeader" -> False,
"RestPagesFooter" -> False,
"RestPagesHeader" -> False,
"PageSize" -> pageSize,
"PaperSize" -> pageSize/mag,
"PrintingMargins" -> {{0, 0}, {0, 0}}(*Floor[{{pdfMarginL,
0}, {pdfMarginB, 0}}*.72]*)
},
WindowElements -> None,
NotebookFileName -> nb,
StyleDefinitions ->
Notebook[{
Cell[StyleData[StyleDefinitions -> "Default.nb"]],
Cell[
StyleData[All],
CellMargins -> {{0, 0}, {0, 0}},
ShowCellBracket -> False
]
}],
WindowTitle -> FileBaseName[pdf]
}
];
NotebookPrint[nbobj, Interactive -> True];
NotebookClose[nbobj];
If[! exists, Quiet@DeleteFile[nb]];
If[FileExistsQ@targetFile,
RenameFile[targetFile, pdf, OverwriteTarget -> True];
openR = OpenRead[pdf, BinaryFormat -> True];
str = ReadString[pdf];
Close[openR];
openW = OpenWrite[pdf, BinaryFormat -> True];
WriteString[pdf,
StringReplace[str,
Shortest["/MediaBox " ~~ "[" ~~ __ ~~ "]"] :>
"/MediaBox [ " <>
StringRiffle[
Join[
{pdfMarginL, pdfMarginB} - boxPad,
{pdfMarginL, pdfMarginB} + pageSize + boxPad
]
] <> " ]"]
];
Close[openW];
pdf,
$Failed
]
]
You must save the file from Save as PDF
to the path specified in the "ScratchFile"
option, which has a horribly botched page size by default no matter what I try. So then I literally edit the PDF text so the "MediaBox"
setting is the right size.
As I say, it's a terrible hack, but until WRI pushes a paclet to fix this we're stuck.
On the plus side, this does work, so I don't need to find a way to revert my OS upgrade to get working PDFs again.