Reducing the number of fonts available to specific applications

You can do it with this script:

 (*
 Create Font Sample.scpt

Modified by b.leopard on macosxhints.com to include a dialog

This script creates a font sample of the selected fonts in FontBook.app

Copyright © Apple Computer, Inc.

 You may incorporate this Apple sample code into your program(s) without
 restriction.  This Apple sample code has been provided "AS IS" and the
 responsibility for its operation is yours.  You are not permitted to
 redistribute this Apple sample code as "Apple sample code" after having
 made changes.  If you're going to redistribute the code, we require
 that you make it clear that the code was descended from Apple sample
 code, but that you've made changes.

 Modifications made at 2007-04-26     Please contact me in case of further enhancements: b.schreyer@erco.com

*)

set fontSize to 16

repeat

        set sampleString to "The quick brown fox jumps over the lazy cat."
    display dialog "Create font sample of all selected fonts in FontBook.app?"      & ¬
         return & return & "Enter sample text:" default answer sampleString ¬
         buttons {"Cancel", "open FontBook", "OK"} default button 3
     set {buttonReturned, sampleString} to ¬
            {button returned of the result, text returned of the result}
     if buttonReturned is "Cancel" then
         error number -128 -- quit
     else if buttonReturned is "open FontBook" then -- open FontBook.app and quit
         tell application "Font Book" to activate
         error number -128 -- quit
     else -- sample text
         if the sampleString is not "" then
             set sampleString to sampleString & " – "

             set fontSize to text returned of (display dialog "What font size " & ¬
                 "should be used in the sample?" default answer fontSize) as number
            exit repeat
         end if
    end if


end repeat

 tell application "Font Book"

     tell application "System Events"
         set wasTextEditRunning to (name of processes) contains "TextEdit"
     end tell

     --    tell application TextEditApp to activate

      set selectedFamilies to selected font families
      set selectedTypefaces to selection

     set numFamilies to count selectedFamilies
     set numFaces to count selectedTypefaces

          tell application "TextEdit"
        if wasTextEditRunning then
             make new document at the end of documents of it
         end if
         tell the front document
             set paragraph 1 to "Font Samples - " & ¬
                  numFamilies & " families   " & ¬
                  numFaces & " typefaces" & return & return & return
             set size to 18
        end tell
     end tell

     --    asuuming that items in selection are sorted in font family.

     set paraIndex to 3

     repeat while selectedTypefaces is not {}
          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

        tell the front document of application "TextEdit"
            tell paragraph paraIndex
                set font to "LucidaGrande"
                set size to 12
                set characters to familyName & return & return
                set the color of every word to ¬
                {32867, 32867, 32867} -- 50% gray
             end tell
             set paraIndex to paraIndex + 1

             repeat with psName in postScriptNames
                 set success to true
                 try
                tell paragraph paraIndex
                    set font to psName
                    set size to fontSize
                    set characters to tab & sampleString & ¬
                        psName & return & return
                end tell
            on error
                set success to false
            end try
            if success then
                set paraIndex to paraIndex + 1
            end if
        end repeat
        set paragraph paraIndex to return & return
        set paraIndex to paraIndex + 1
    end tell

end repeat
tell application "TextEdit" to activate
end tell

This will return something like this:

And the final result:

I didn't find any way to modify the style of the selection, but you could use UI scripting to select a font from the format bar.

tell application "System Events" to tell process "Keynote"
    tell pop up button 1 of window 1
        click
        click menu item "Menlo" of menu 1
    end tell
end tell

You could assign shortcuts to the scripts with FastScripts or by creating Automator services.