Here is a small set of functions I came up with.
font-cycle-list
a list of font named to cycle.
font-cycle-forward
, font-cycle-backward
are interactive functions to bind to keys.
- This is initialized on first use, including the current font in the list if it's not already included.
;; Must be initialized to a list of strings.
(defvar font-cycle-list nil)
;; The index of the font in `font-cycle-index',
;; initialized on first use.
(defvar font-cycle-index nil)
(defun font-cycle--index-update ()
(set-face-attribute 'default nil :font (nth font-cycle-index font-cycle-list)))
(defun font-cycle-list--index-ensure (font-name font-name-no-attrs)
"Add to the font list or return index if it's not already there."
(catch 'result
(let ((index 0))
(dolist (font-name-iter font-cycle-list)
(when (string-equal font-name-no-attrs (car (split-string font-name-iter ":")))
(throw 'result index))
(setq index (1+ index))))
(push font-name font-cycle-list)
;; First in the list (don't bother adding in ordered).
(throw 'result 0)))
;; Use custom font from environment when available.
(defun font-cycle--init ()
"Initialize `font-cycle-index', adding to `font-cycle-list'
or replacing one of it's values when the default font is already in the list.
Replacement is done so any fine tuning to the default font is kept (attributes for e.g)."
(unless font-cycle-list
(user-error "The variable 'font-cycle-list' is not a list of fonts!"))
(let ((font-index-test nil))
(let ((current-font (font-get (face-attribute 'default :font) :name)))
(unless (string-equal current-font "")
(let ((current-font-no-attrs (car (split-string current-font ":"))))
(setq font-index-test
(font-cycle-list--index-ensure
current-font
current-font-no-attrs)))))
(if font-index-test
(setq font-cycle-index font-index-test)
;; Fall-back to first font (unlikely we can't find our own font).
(unless font-cycle-index
(setq font-cycle-index 0))
(font-cycle--index-update))))
;; Run once, when placing the current font in the cycle list.
(defun font-cycle--ensure-once ()
(unless font-cycle-index
(font-cycle--init)))
;; Public Functions.
(defun font-cycle-step (arg)
"Cycle the font in `font-cycle-list' forward or backward ARG times (default to 1)."
(interactive "p")
(unless (display-graphic-p)
(user-error "Cannot cycle fonts on non-graphical frame window."))
(font-cycle--ensure-once)
(setq arg (or arg 1))
(setq font-cycle-index (mod (+ font-cycle-index arg) (length font-cycle-list)))
(font-cycle--index-update)
(message (nth font-cycle-index font-cycle-list)))
(defun font-cycle-forward (arg)
(interactive "p")
(font-cycle-step 1))
(defun font-cycle-backward (arg)
(interactive "p")
(font-cycle-step -1))
Font list and key bindings:
(setq font-cycle-list
(list
"Anonymous Pro Medium 14"
"Consolas 15"
"Fantasque Sans Mono Medium 14"
"Fira Code Medium 13"
"Hermit Medium 13"
"IBM 3270 Medium 17"
"IBM Plex Mono 13"
"Inconsolata-g 13"
"Input Mono Light 15"
"Iosevka Medium 17"
"Luculent Medium 16"
"Monoid Medium 13"
"Source Code Pro Medium 10"))
;; Key bindings Alt-PageUp/Down.
(when (display-graphic-p)
(define-key global-map (read-kbd-macro "<M-prior>") 'font-cycle-forward)
(define-key global-map (read-kbd-macro "<M-next>") 'font-cycle-backward))