Font Catalog Script

Below is offered a script that creates a Font Catalog of all currently selected fonts in FontBook, and is what I think a much improved version of the standard script that comes with Mac OS X.

The script has the following features:
*Asks the user for a name to call the catalog using a prompt (this will form part of the page header)
*Applies a bit of paragraph spacing in TextEdit
*Saves it as a Word docx file
*Opens the file in Word 2008
*Applies further formatting in Word, including adding page numbering, a horizontal line along the top and bottom of the page in header/footer, and adds a header that includes the title of the font collection input by the user.

Right, first off I’d like to say a big thank you StefanK, a member of these forums who has given me all the help needed towards producing this. The script is essentially 99.9% Stefan’s work. I simply added the Word 2008 formatting, and it would have taken me ages to do this all myself.

The script has been tested fully and tweaked, but has one limitation which members may like to offer possible solutions to.
The script doesn’t allow for complete unattended operation to produce the final formatted catalog:
Should “font-cat.docx” already exist before the script is run, when TextEdit tries to save the “font-cat.docx” it will generate a prompt asking to confirm whether or not to replace the file. To avoid the script opening up the OLDER catalog in Word 2008 rather than the new one (which would occur without some sort of conditional), I needed a way to pause the script whilst I confirmed TextEdit’s dialog to replace the existing “font-cat.docx” file. The only way I knew how to do this was to display a prompt “Open file in Word?” to condition execution of the rest of the script from the point where TextEdit’s docx saved file should open in Word.

Anyway, here is the working script:

global paraIndex
property black : {0, 0, 0}
property grey : {32867, 32867, 32867}

set sampleString to "abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ 0123456789"

set myCat to ""

repeat while myCat is ""
	display dialog "the text" default answer "Adobe Font Folio 11" buttons ["OK", "Cancel"] default button 1
	if (text returned of result) ≠ "" then
		set myCat to (text returned of result)
	else
		display dialog "Please enter a name for the catalog." buttons ["OK"] default button 1
	end if
end repeat

tell application "Font Book" to set {selectedFamilies, selectedTypefaces} to {selected font families, selection}
set numFamilies to count selectedFamilies
set numFaces to count selectedTypefaces

set paraIndex to 1
tell application "TextEdit"
	close documents
	make new document with properties {text:return}
	my insert_Paragraph("Font Samples - " & numFamilies & " families " & numFaces & " typefaces", "LucidaGrande", 8, black, 3)
end tell

repeat while selectedTypefaces is not {}
	tell application "Font Book"
		set thisFace to first item of selectedTypefaces
		set familyName to family name of thisFace
		set selectedTypefaces to the rest of selectedTypefaces
		set postScriptNames to {PostScript name of thisFace}
		
		repeat while selectedTypefaces is not {}
			set anotherFace to first item of selectedTypefaces
			if family name of anotherFace is familyName then
				set the end of postScriptNames to PostScript name of anotherFace
				set selectedTypefaces to the rest of selectedTypefaces
			else
				exit repeat
			end if
		end repeat
	end tell
	tell the front document of application "TextEdit"
		-- my insert_Paragraph(familyName, "LucidaGrande", 14, grey, 2)
		repeat with psName in postScriptNames
			my insert_Paragraph(psName, "LucidaSans", 10, black, 2)
			my insert_Paragraph(sampleString, psName, 15, black, 3)
		end repeat
		-- set paragraph paraIndex to return & return
		-- set paraIndex to paraIndex + 1
	end tell
	
end repeat

activate application "TextEdit"

tell application "System Events" to tell process "TextEdit"
	
	keystroke "a" using {command down}
	click menu item "Spacing..." of menu "Text" of menu item "Text" of menu "Format" of menu bar item "Format" of menu bar 1
	repeat until exists sheet 1 of window 1
		delay 0.2
	end repeat
	tell sheet 1 of window 1
		set value of text field 6 to "2.1"
		click button "OK"
	end tell
	
	keystroke "s" using {command down, shift down}
	tell window 1
		repeat until exists sheet 1
			delay 0.1
		end repeat
		tell sheet 1
			keystroke "d" using command down -- make destination Desktop
			tell pop up button 1 of group 1 of group 1
				click
				delay 0.2
				click menu item "Word 2007 Format (docx)" of menu 1
				delay 1
			end tell
			set value of text field 1 to "font-cat.docx"
			click button "Save"
			set question to display dialog "Open in Word?" buttons {"Open in MS Word 2008", "Exit"} default button 1
			set answer to button returned of question
			
		end tell
		
	end tell
end tell

if (answer = "Open in MS Word 2008") then
	activate "Microsoft Word"
	tell application "Microsoft Word"
		open ((path to desktop as text) & "font-cat.docx")
		set theName to name of active document
		set theDoc to document theName -- this allows the document to be identified should it not still be the currently active document (Word always re-evaluates references)
		set myPgSetup to page setup of theDoc -- ORIGNALLY: set myPgSetup to page setup of active document
		set left margin of myPgSetup to 42
		set right margin of myPgSetup to 42
		set top margin of myPgSetup to 42
		set bottom margin of myPgSetup to 42
		set footer distance of myPgSetup to 25.5
		
		set myTopBorder to get border section 1 of theDoc which border border top
		set myBtmBorder to get border section 1 of theDoc which border border bottom
		set line style of myTopBorder to line style single
		set line width of myTopBorder to line width25 point
		set line style of myBtmBorder to line style single
		set line width of myBtmBorder to line width25 point
		set surround header of border options of section 1 of theDoc to false
		set surround footer of border options of section 1 of theDoc to false
		
		set space before of paragraph 1 of active document to 3
		
		set myFooter to (get footer section 1 of theDoc index header footer primary)
		set myHeader to (get header section 1 of theDoc index header footer primary)
		
		set content of text object of myHeader to "Font Catalogue:  " & myCat
		set myRange to text object of myHeader
		set font size of font object of myRange to 8
		set alignment of paragraph format of myRange to align paragraph right
		set name of font object of myRange to "Arial"
		set space after of paragraph format of myRange to 3
		
		make new page number at myFooter with properties {alignment:align page number outside}
		set myRange to text object of myFooter
		set font size of font object of myRange to 9 -- just to make page numbering size 9pt
		
		save document "font-cat.docx"
	end tell
	
end if


on insert_Paragraph(theText, theFont, theSize, theColor, numberOfReturns)
	local ret
	set ret to ""
	repeat numberOfReturns times
		set ret to ret & return
	end repeat
	tell the front document of application "TextEdit"
		count paragraphs
		try
			tell paragraph paraIndex
				set font to theFont
				set size to theSize
				set characters to theText & ret
				set color of every word to theColor
				set paraIndex to paraIndex + numberOfReturns - 1
				return true
			end tell
		on error
			return false
		end try
	end tell
end insert_Paragraph

what’s about to delete the old file (if it exists) before creating the new one


.

		-- set paraIndex to paraIndex + 1
	end tell
	
end repeat

try
	do shell script "rm " & quoted form of (POSIX path of (path to desktop) & "font-cat.docx")
end try

activate application "TextEdit"

tell application "System Events" to tell process "TextEdit"
.

and replace


open "Macintosh HD:Users:anthonylowe:Desktop:font-cat.docx"

with

open ((path to desktop as text) & "font-cat.docx")

then it’s fully portable :wink:

Thanks agaiin Stefan! Both those updates work brilliantly. :slight_smile: Just wondering how I can get TextEdit to close the document and quit after its saved the .docx (before the Word 2008 code). I’m supposing I need a conditional on it, rather than just writing the necessary close and quit commands after the save command. i.e. to test if actually saved.


.
if (answer = "Open in MS Word 2008") then
	tell application "TextEdit"
		close document 1 saving no
		quit
	end tell
	-- activate "Microsoft Word" -- useless, doesn't do anything
	tell application "Microsoft Word"
		activate
		open ((path to desktop as text) & "font-cat.docx")
		
.

I’ve taken out the prompt conditional bits, i.e.

set question to display dialog "Open in Word?" buttons {"Open in MS Word 2008", "Exit"} default button 1
set answer to button returned of question
...
if (answer = "Open in MS Word 2008") then

as its not needed with your solution

try
   do shell script "rm " & quoted form of (POSIX path of (path to desktop) & "font-cat.docx")
end try

so could i now just do this…


tell application "System Events" to tell process "TextEdit"
...
 set value of text field 1 to "font-cat.docx"
           click button "Save"
close document 1 saving no
       quit
end tell
end tell
end tell

 activate "Microsoft Word"
   tell application "Microsoft Word"
...

I’m not sure if “close document 1 saving no” will wait until the Save command has fully completed.

once again

activate "Microsoft Word"

activates the string “Microsoft Word” i.e. it just does nothing

either

activate application "Microsoft Word"

or, within a tell block


tell application "Microsoft Word"
activate
.

Okay, but specifically is my method of quitting TextEdit okay after the save command:

...
keystroke "d" using command down -- make destination Desktop
tell pop up button 1 of group 1 of group 1
click
delay 0.2
click menu item "Word 2007 Format (docx)" of menu 1
delay 1
end tell
set value of text field 1 to "font-cat.docx"
click button "Save"
close document 1 saving no
quit

I get an error message “Can’t get document 1 of sheet 1 of window 1 of process “TextEdit”.”

I assuming the close document 1 saving no is jumping in before the file is actually saved.

yes, why not?
But to avoid timing problems reliably, insert


.
click button "Save"
	repeat while exists sheet 1
		delay 0.1
	end repeat
	close document 1 saving no
	quit
.

make sure, that the repeat block is outside the tell sheet block

Just solved it! I put

close document 1 saving no
quit

in the wrong “tell” section. Doh!

The complete updated script is shown below:

global paraIndex
property black : {0, 0, 0}
property grey : {32867, 32867, 32867}

set sampleString to "abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ 0123456789"

set myCat to ""

repeat while myCat is ""
	display dialog "the text" default answer "Adobe Font Folio 11" buttons ["OK", "Cancel"] default button 1
	if (text returned of result) ≠ "" then
		set myCat to (text returned of result)
	else
		display dialog "Please enter a name for the catalog." buttons ["OK"] default button 1
	end if
end repeat

tell application "Font Book" to set {selectedFamilies, selectedTypefaces} to {selected font families, selection}
set numFamilies to count selectedFamilies
set numFaces to count selectedTypefaces

set paraIndex to 1
tell application "TextEdit"
	-- if not (exists document 1) then make new document at the end of documents with properties {text:return}
	close documents
	make new document with properties {text:return}
	my insert_Paragraph("Font Samples - " & numFamilies & " families " & numFaces & " typefaces", "LucidaGrande", 8, black, 3)
end tell

repeat while selectedTypefaces is not {}
	tell application "Font Book"
		set thisFace to first item of selectedTypefaces
		set familyName to family name of thisFace
		set selectedTypefaces to the rest of selectedTypefaces
		set postScriptNames to {PostScript name of thisFace}
		
		repeat while selectedTypefaces is not {}
			set anotherFace to first item of selectedTypefaces
			if family name of anotherFace is familyName then
				set the end of postScriptNames to PostScript name of anotherFace
				set selectedTypefaces to the rest of selectedTypefaces
			else
				exit repeat
			end if
		end repeat
	end tell
	tell the front document of application "TextEdit"
		-- my insert_Paragraph(familyName, "LucidaGrande", 14, grey, 2)
		repeat with psName in postScriptNames
			my insert_Paragraph(psName, "LucidaSans", 10, black, 2)
			my insert_Paragraph(sampleString, psName, 15, black, 3)
		end repeat
		-- set paragraph paraIndex to return & return
		-- set paraIndex to paraIndex + 1
	end tell
	
end repeat

try
	do shell script "rm " & quoted form of (POSIX path of (path to desktop) & "font-cat.docx")
end try

activate application "TextEdit"

tell application "System Events" to tell process "TextEdit"
	
	keystroke "a" using {command down}
	click menu item "Spacing..." of menu "Text" of menu item "Text" of menu "Format" of menu bar item "Format" of menu bar 1
	repeat until exists sheet 1 of window 1
		delay 0.2
	end repeat
	tell sheet 1 of window 1
		set value of text field 6 to "2.1"
		click button "OK"
	end tell
	
	keystroke "s" using {command down, shift down}
	tell window 1
		repeat until exists sheet 1
			delay 0.1
		end repeat
		tell sheet 1
			keystroke "d" using command down -- make destination Desktop
			tell pop up button 1 of group 1 of group 1
				click
				delay 0.2
				click menu item "Word 2007 Format (docx)" of menu 1
				delay 1
			end tell
			set value of text field 1 to "font-cat.docx"
			click button "Save"
		end tell
		
	end tell
end tell

tell application "TextEdit"
	close document 1 saving no
	quit
end tell


tell application "Microsoft Word"
	activate
	open ((path to desktop as text) & "font-cat.docx")
	set theName to name of active document
	set theDoc to document theName -- this allows the document to be identified should it not still be the currently active document (Word always re-evaluates references)
	set myPgSetup to page setup of theDoc -- ORIGNALLY: set myPgSetup to page setup of active document
	set left margin of myPgSetup to 42
	set right margin of myPgSetup to 42
	set top margin of myPgSetup to 42
	set bottom margin of myPgSetup to 42
	set footer distance of myPgSetup to 25.5
	
	set myTopBorder to get border section 1 of theDoc which border border top
	set myBtmBorder to get border section 1 of theDoc which border border bottom
	set line style of myTopBorder to line style single
	set line width of myTopBorder to line width25 point
	set line style of myBtmBorder to line style single
	set line width of myBtmBorder to line width25 point
	set surround header of border options of section 1 of theDoc to false
	set surround footer of border options of section 1 of theDoc to false
	
	set space before of paragraph 1 of active document to 3
	
	set myFooter to (get footer section 1 of theDoc index header footer primary)
	set myHeader to (get header section 1 of theDoc index header footer primary)
	
	set content of text object of myHeader to "Font Catalogue:  " & myCat
	set myRange to text object of myHeader
	set font size of font object of myRange to 8
	set alignment of paragraph format of myRange to align paragraph right
	set name of font object of myRange to "Arial"
	set space after of paragraph format of myRange to 3
	
	make new page number at myFooter with properties {alignment:align page number outside}
	set myRange to text object of myFooter
	set font size of font object of myRange to 9 -- just to make page numbering size 9pt
	
	save document "font-cat.docx"
end tell


on insert_Paragraph(theText, theFont, theSize, theColor, numberOfReturns)
	local ret
	set ret to ""
	repeat numberOfReturns times
		set ret to ret & return
	end repeat
	tell the front document of application "TextEdit"
		count paragraphs
		try
			tell paragraph paraIndex
				set font to theFont
				set size to theSize
				set characters to theText & ret
				set color of every word to theColor
				set paraIndex to paraIndex + numberOfReturns - 1
				return true
			end tell
		on error
			return false
		end try
	end tell
end insert_Paragraph

Although the script works well with a small collection of typefaces, I found the Script Editor reported an event handler time out during the Word formatting commands.
With a massive collection of typefaces it takes ages for the typeface samples to populate the document. I think there needs to be a way of knowing when Word has completed populating the document and use this to trigger the rest of the code after this bit:

tell application "Microsoft Word"
activate
open ((path to desktop as text) & "font-cat.docx")
   set theName to name of active document
   set theDoc to document theName