pete@esosun.UUCP (Pete Ware) (07/31/87)
The following pops up a menu of X fonts, waits for a selection and then
sets the new font to be the one selected. It is bound to shift-middle-button.
You may need to change the directory it searches for the fonts.
----------------------------------------------------------------------
(defun x-choose-font (arg)
"Provide a menu of fonts and allow one to be selected.
It becomes the current font. Default is vtsingle"
(interactive)
(let
((files (directory-files "/usr/local/lib/X/font" nil nil))
(count 0)
(head nil)
(menu nil))
;;;
;;; Menu format is ("title" ("prompt-1" (item-1 . ret-val) ...)
;;; ("prompt-2" (item-1 . ret-val) ...) ...)
;;;
(while files
(while (and files (> (window-height) count))
(let ((file (car files)))
(setq files (cdr files))
(if (not (or (string= "." file) (string= ".." file)))
(progn
(setq count (1+ count))
(setq head (cons (cons (format "%14s" file) file) head))
)
)
)
)
(let ((first) (last))
(setq last (car (car head)))
(setq head (nreverse head))
(setq first (car (car head)))
(setq menu (cons (cons
(format "%s to %s"
(substring first 0 -4)
(substring last 0 -4)) head) menu)))
(setq head nil)
(setq count 0)
)
(setq menu (nreverse menu))
(setq menu (cons "Fonts" menu))
(x-set-font
(substring (or (x-popup-menu arg menu) "vtsingle.onx")
0 -4))))
(define-key mouse-map x-button-s-middle 'x-choose-font)
----------------------------------------------------------------------
--
esosun!pete@seismo.CSS.GOV (Pete Ware) (619) 458-2520
{seismo,sdcsvax}!esosun!pete