Script Font Family?

Is there a way to script setting the font family of a selection or all text in a RTF document? Not set all to just one style in one typeface like Helvetica-Regular or Times-Bold. Instead set all to one font family where the original Plain, Bold, Italic, etc. styles are maintained as are the type sizes.

This would be similar to the way it works now from the keyboard. Select an entire block or smaller selection of text. Choose a new Family in the standard Fonts dialog. Nothing is selected in regular, italic, or bold styles in the Typeface column or is any size in the type size column.

And the result is an overall change to a new font family in the document. The original regular, italic or bold styles are retained if they are available in the new font family. The original sizes are also retained.

Here’s a simple code snippet demonstrating how to do this:


tell application id "com.devon-technologies.thinkpro2"
	tell text of think window 1
		try
			repeat with theAttribute in attribute runs
				set oldFont to font of theAttribute
				set newFont to "Helvetica"
				if oldFont contains "bold" or oldFont contains "Bold" then set newFont to newFont & "-Bold"
				set font of theAttribute to newFont
			end repeat
		end try
	end tell
end tell

Requires of course more work :wink:

@cgrunenberg: Thanks for the great idea.

I’d rather work with just a selection and not an entire file, so this is the rough Applescript using your concept that I have been trying. I also set some overall default properties to the selection at the same time.

tell application id "com.devon-technologies.thinkpro2"
	activate
	try
		--copy selection to Clipboard
		tell application "System Events"
			keystroke "c" using (command down)
		end tell
		
		tell selected text of think window 1 --only for a selection, replace with "tell text of think window 1" for entire document
			
			--name of new default font family (must include italic named and not oblique named typefaces)
			set newFont to "Verdana"
			
			repeat with theAttribute in attribute runs
				set oldFont to font of theAttribute --determine current typeface
				
				--convert old typeface names to new typeface names then set new fonts (typefaces) in font family
				if oldFont contains "bolditalic" or oldFont contains "BoldItalic" or oldFont contains "oblique" or oldFont contains "Oblique" then
					set font of theAttribute to newFont & "-BoldItalic"
				else
					if oldFont contains "bold" or oldFont contains "Bold" then
						set font of theAttribute to newFont & "-Bold"
					else
						if oldFont contains "italic" or oldFont contains "Italic" or oldFont contains "oblique" or oldFont contains "Oblique" then
							set font of theAttribute to newFont & "-Italic"
						else
							set font of theAttribute to newFont --remainder change font family name only
						end if
					end if
				end if
			end repeat
			
			--set overall default properties
			set properties to {color:{5000, 5000, 5000}, background:{65535, 65535, 65535}, alignment:left, line spacing:1.0, paragraph spacing:8.0}
			
			--dialog for Undo
			set dialog_title to "Selection Standard Format Indent"
			set dialog_words to "Undo will not change this back" & return ¬
				& "but previous version is in the Clipboard." & return ¬
				& return ¬
				& "Cancel now or Paste (Cmd+V) later to restore."
			
			display dialog dialog_words with title dialog_title default button "Ok"
		end tell
	on error errText
		--if Cancel then paste, replacing selection with original
		tell application "System Events"
			keystroke "v" using (command down)
		end tell
	end try
end tell

Now if there also was a way to delete empty paragraphs from the RTF document. My scripting capability is limited and the attempts to do that have also resulted in losing the font attributes for successive paragraphs.

Thanks again for your help with this.

It’s similar to scripting attribute runs:


tell application id "com.devon-technologies.thinkpro2"
	tell text of think window 1
		repeat with thePara in paragraphs
			try
				if length of ((text of thePara) as string) is 1 then set text of thePara to ""
			end try
		end repeat
	end tell
end tell

Thanks again, but with my limited understanding of Applescript I couldn’t solve why your last code snippet only somewhat worked. It removed empty paragraphs at the beginning of a file but then stop removing them producing a series of errors repeating to the end of file:

	get every text of item 15 of every paragraph of every text of think window 1
		--> error number -1719 from item 15 of every paragraph of every text of think window 1
	get every text of item 16 of every paragraph of every text of think window 1
		--> error number -1719 from item 16 of every paragraph of every text of think window 1


```Is this due to making changes to the contents within the repeat loop?

Yes. A simple workaround is to exit the loop after each modification and to redo the loop (by adding an enclosing loop).

If this was text, I’d accumulate revised text without the empty paragraphs in a new variable. Probably using nested repeat loops. But RFT content and those attribute runs remain mystifying to me.

I could not figure out how to “redo the loop” as you’d suggested. This is basically what I tried;```
tell application id “com.devon-technologies.thinkpro2”
tell selected text of think window 1
set currentCount to 0
set maxCount to count of paragraphs
set i to 0
repeat with i from currentCount to maxCount
set j to 0
repeat with thePara in paragraphs
if length of ((text of thePara) as string) is 1 then
set text of thePara to “”
set currentCount to currentCount + j
exit repeat
end if
set j to j + 1
end repeat
end repeat
end tell
end tell

Could you give me a clue as to the technique you were thinking of? And, thanks again for your help with this.

The first example uses two loops as suggested:


tell application id "com.devon-technologies.thinkpro2"
	tell text of think window 1
		set isModified to true
		repeat while isModified
			set isModified to false
			repeat with thePara in paragraphs
				if length of ((text of thePara) as string) is 1 then
					set text of thePara to ""
					set isModified to true
					exit repeat
				end if
			end repeat
		end repeat
	end tell
end tell

The second example uses one loop and is faster:


tell application id "com.devon-technologies.thinkpro2"
	tell text of think window 1
		set i to 1
		set cnt to number of paragraphs
		repeat while i ≤ cnt
			if length of ((text of paragraph i) as string) is 1 then
				set text of paragraph i to ""
				set cnt to cnt - 1
			else
				set i to i + 1
			end if
		end repeat
	end tell
end tell

Outstanding! Thanks your time writing code that both solves a specific problem and is instructional. Repeat while loops being the key for me.

Both versions work like a charm on the entire file. But I also was trying to limit actions to just selected text and assume the “set text” code knocks out the selection. Then subsequent counts of paragraphs remain zero. Is there a workaround for that or is it simply the nature of the first scripting change to text content then unselecting? As would text changes made from the keyboard.

Changing the selected text removes the selection and therefore this is not possible.

Since I have your WordService package of services installed, in an Eureka moment I tried this script. It does remove the empty paragraphs (multiple returns) from a text selection. Slow, but it works and is offered for the record as a different approach.```
set appName to “DEVONthink Pro Office”
–set appName to application id “com.devon-technologies.thinkpro2” as string
set menuName to “DEVONthink Pro Office”
set menuItem to “Services”
set subMenuItem to “Remove Multiple Feeds”
say “Please wait. This will take a while.”
do_submenu(appName, menuName, menuItem, subMenuItem)
return result --result is “true” if this works, “false” and an error if not

on do_submenu(appName, menuName, menuItem, subMenuItem)
try
tell application appName --bring the target application to the front
activate
end tell
tell application “System Events”
tell process appName
tell menu bar 1
tell menu bar item menuName
tell menu menuName
tell menu item menuItem
tell menu menuItem
click menu item subMenuItem
end tell
end tell
end tell
end tell
end tell
end tell
end tell
return true
on error error_message
return false
end try
end do_submenu