So, I notice that there is list-faces-display and list-colors-display (very nice), but there is no list-fonts-display. Why? I wrote one that works pretty well for windows. Maybe somebody else that understands windows and x fonts would improve this? -jeff ================================================================ (defun facemenu-get-face-font (symbol) (let ((name (symbol-name symbol))) (cond ((find-face symbol) symbol) ((string-match "^font:" name) (let* ((face (make-face symbol)) (font (substring name 5))) (if (font-instance-p (make-font-instance font nil t)) (set-face-font face (make-font-instance font)) (if (font-instance-p (make-font-instance (concat font "::::Symbol") nil t)) (set-face-font face (make-font-instance (concat font "::::Symbol"))) (progn;;(warn "Font `%s' undefined" font) (setq symbol nil))))) symbol) (t (facemenu-get-face symbol))))) (defun list-fonts-regexp (regexp) (let ((result nil)) (dolist (font-string (list-fonts "") (nreverse result)) (when (or (null regexp) (string-match regexp font-string)) (push font-string result))))) (defun my-list-fonts (&optional pattern do-fontname) (let ((result nil) font (families nil)) (dolist (font-string (list-fonts "")) ;; windows list-fonts returns fonts like "Tera Special::::Symbol", mswindows-font-create-object returns courier ;; So, I have to smash the pattern to include a pointsize (when (or (null pattern) (string-match pattern font-string)) (setq font-string (if (string-match "^\\([a-zA-Z ]+\\):\\([a-zA-Z]*\\)\\( [a-zA-Z]*\\)?:\\([0-9]*\\):\\([a-zA-Z ]*\\):\\([a-zA-Z 0-9]*\\)$" font-string) (let ((family (match-string 1 font-string)) (weight (match-string 2 font-string)) (style (match-string 3 font-string)) (pointsize (match-string 4 font-string)) (effects (match-string 5 font-string)) (charset (match-string 6 font-string))) (concat family ":" ":" (if (equal pointsize "") "10" pointsize) ":" effects ":" charset)) font-string)) ;;(setq font (make-fontobj font-string)) (setq font (if (string-match "[-*]" font-string) (x-font-create-object font-string) (mswindows-font-create-object font-string))) (if (and (font-family font) (not (member (car (font-family font)) result))) (push (if do-fontname font-string (car (font-family font))) result)))) (nreverse result))) (require 'facemenu) (defun list-fonts-display (&optional list matching) (interactive) (if (null matching) (setq matching "")) (setq list (facemenu-unique (my-list-fonts ""))) (with-output-to-temp-buffer "*Fonts*" (save-excursion (set-buffer standard-output) (let ((facemenu-unlisted-faces t) s) (while list (let ((face (facemenu-get-face-font (intern (concat "font:" (car list)))))) (setq s (point)) (insert (car list)) (indent-to 30) (setq s (point)) (cond (face (insert " " "abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ" "\n") (put-text-property s (point) 'face face)) (t (insert "invalid\n")))) (setq list (cdr list)))))))