insert text with a particular font

Question

When I do s-left-mouse-click, and select "Change Buffer font...", I get a pretty display of sample text showing me what the various fonts look like. I'd like to reproduce similar behavior in a buffer.

I'd like to iterate over the values given by (font-family-list), print the name of the font-family, and a sample text with that family applied.

I got this far:

(dolist (curfam (font-family-list))
  (print curfam (current-buffer))
  )

which gives me the desired list of family names. Now I'm looking into customizing faces, and I'm starting to think what I want to do is really kinda tricky. Maybe that's why I only find what I'm looking for in a gtk box.

While I have some thoughts how to accomplish this, they seem pretty complicated -- creating a custom face for each family, setting those face properties, and setting the face for the current line somehow.

Here's my plan:

1. For each family, create a face, with correct font-family.
2. Insert the desired text.
3. Apply the face to the desired text.

Here are my questions:

1. Is this the right approach? Is there a simpler way?
2. How do I apply the face to the desired text. Can I apply a face line by line, or do I have to make some kind of font lock mode?

Answer 1

There is a simpler way (unless you're using XEmacs for whatever reason), propertizing the text you're going to insert with an anonymous face having the respective font-family, then inserting it:

(defun my-font-preview ()
  (interactive)
  (let ((buffer-name "*font families*"))
    (with-current-buffer (get-buffer-create buffer-name)
      (erase-buffer)
      (dolist (font-family (font-family-list))
        (insert (propertize font-family 'face `(:family ,font-family))
                "\n"))
      (goto-char (point-min)))
    (pop-to-buffer-same-window buffer-name)))