November 13th, 2006
An Emacs diversion: Font sizes
After a few weeks of very intense JRuby-OpenSSL hacking, I felt the need to do something different, so I’ve spent a few hours with my slightly rusty Emacs Lisp skills, trying to fix something that I really need. Namely, control over font-size and fonts in Emacs, on Linux. I want it inside Emacs and customizable by EL. To my surprise I couldn’t find anything like that anywhere.
For me personally, it’s necessary when presenting, since I usually code with a small font in Emacs, the code will be totally unreadable when presenting. And since I don’t have a fancy MacBook Pro, I need to be able to zoom in and out inside Emacs.
Presto, it wasn’t easy, but I’ve managed it. For some reason, font handling seems quite backward in Emacs. I had to extract the current font, and then split it and join the new array together again. Not neat and my way of doing it is not the best. But, for your pleasure, here is the code to do it, and also some code that establishes a font ring of the standard fonts in different sizes that can be walked through:
(defun inc-font-size ()
(interactive)
(let* ((current-font (cdr (assoc 'font (frame-parameters))))
(splitted (split-string current-font "-"))
(new-size (+ (string-to-number (nth 7 splitted)) 1))
(new-font (concat (nth 0 splitted) "-"
(nth 1 splitted) "-"
(nth 2 splitted) "-"
(nth 3 splitted) "-"
(nth 4 splitted) "-"
(nth 5 splitted) "-"
(nth 6 splitted) "-"
(number-to-string new-size) "-*-"
(nth 9 splitted) "-"
(nth 10 splitted) "-"
(nth 11 splitted) "-*-"
(nth 13 splitted))))
(if (> (length splitted) 14)
(dotimes (n (- (length splitted) 14))
(setq new-font (concat new-font "-" (nth (+ n 14) splitted)))))
(set-default-font new-font t)
(set-frame-font new-font t)))
(defun dec-font-size ()
(interactive)
(let* ((current-font (cdr (assoc 'font (frame-parameters))))
(splitted (split-string current-font "-"))
(new-size (- (string-to-number (nth 7 splitted)) 1))
(new-font (concat (nth 0 splitted) "-"
(nth 1 splitted) "-"
(nth 2 splitted) "-"
(nth 3 splitted) "-"
(nth 4 splitted) "-"
(nth 5 splitted) "-"
(nth 6 splitted) "-"
(number-to-string new-size) "-*-"
(nth 9 splitted) "-"
(nth 10 splitted) "-"
(nth 11 splitted) "-*-"
(nth 13 splitted))))
(if (> (length splitted) 14)
(dotimes (n (- (length splitted) 14))
(setq new-font (concat new-font "-" (nth (+ n 14) splitted)))))
(set-default-font new-font t)
(set-frame-font new-font t)))
(defvar *current-font-index* 0)
(defconst *font-ring* '(
"-urw-nimbus mono l-regular-r-normal--15-*-88-88-p-*-iso8859-1"
"-urw-nimbus mono l-regular-r-normal--17-*-88-88-p-*-iso8859-1"
"-Adobe-Courier-Medium-R-Normal--14-*-100-100-M-*-ISO8859-1"
"-Adobe-Courier-Medium-R-Normal--16-*-100-100-M-*-ISO8859-1"
"-Adobe-Courier-Medium-R-Normal--18-*-100-100-M-*-ISO8859-1"
"-Adobe-Courier-Medium-R-Normal--20-*-100-100-M-*-ISO8859-1"
"-Adobe-Courier-Medium-R-Normal--22-*-100-100-M-*-ISO8859-1"
"-Adobe-Courier-Medium-R-Normal--24-*-100-100-M-*-ISO8859-1"
"-Adobe-Courier-Medium-R-Normal--26-*-100-100-M-*-ISO8859-1"
"-Adobe-Courier-Medium-R-Normal--28-*-100-100-M-*-ISO8859-1"
"-Adobe-Courier-Medium-R-Normal--30-*-100-100-M-*-ISO8859-1"
"-Adobe-Courier-Medium-R-Normal--32-*-100-100-M-*-ISO8859-1"
"-Adobe-Courier-Medium-R-Normal--34-*-100-100-M-*-ISO8859-1"
"-Adobe-Courier-Bold-R-Normal--14-*-100-100-M-*-ISO8859-1"
"-Adobe-Courier-Bold-R-Normal--16-*-100-100-M-*-ISO8859-1"
"-Adobe-Courier-Bold-R-Normal--18-*-100-100-M-*-ISO8859-1"
"-Adobe-Courier-Bold-R-Normal--20-*-100-100-M-*-ISO8859-1"
"-Adobe-Courier-Bold-R-Normal--22-*-100-100-M-*-ISO8859-1"
"-Adobe-Courier-Bold-R-Normal--24-*-100-100-M-*-ISO8859-1"
"-Adobe-Courier-Bold-R-Normal--26-*-100-100-M-*-ISO8859-1"
"-Adobe-Courier-Bold-R-Normal--28-*-100-100-M-*-ISO8859-1"
"-Adobe-Courier-Bold-R-Normal--30-*-100-100-M-*-ISO8859-1"
"-Adobe-Courier-Bold-R-Normal--32-*-100-100-M-*-ISO8859-1"
"-Adobe-Courier-Bold-R-Normal--34-*-100-100-M-*-ISO8859-1"
"-Misc-Fixed-Medium-R-SemiCondensed--10-*-75-75-C-*-ISO8859-1"
"-Misc-Fixed-Medium-R-SemiCondensed--12-*-75-75-C-*-ISO8859-1"
"-Misc-Fixed-Medium-R-SemiCondensed--13-*-75-75-C-*-ISO8859-1"
"-Misc-Fixed-Medium-R-Normal--13-*-75-75-C-*-ISO8859-1"
"-Misc-Fixed-Medium-R-Normal--14-*-75-75-C-*-ISO8859-1"
"-Misc-Fixed-Medium-R-Normal--15-*-75-75-C-*-ISO8859-1"
"-Misc-Fixed-Medium-R-Normal--16-*-75-75-C-*-ISO8859-1"
"-Misc-Fixed-Medium-R-Normal--17-*-75-75-C-*-ISO8859-1"
"-Misc-Fixed-Medium-R-Normal--18-*-75-75-C-*-ISO8859-1"
"-Misc-Fixed-Medium-R-Normal--19-*-75-75-C-*-ISO8859-1"
"-Misc-Fixed-Medium-R-Normal--20-*-75-75-C-*-ISO8859-1"
"-Schumacher-Clean-Medium-R-Normal--12-*-75-75-C-*-ISO8859-1"
"-Schumacher-Clean-Medium-R-Normal--13-*-75-75-C-*-ISO8859-1"
"-Schumacher-Clean-Medium-R-Normal--14-*-75-75-C-*-ISO8859-1"
"-Schumacher-Clean-Medium-R-Normal--15-*-75-75-C-*-ISO8859-1"
"-Schumacher-Clean-Medium-R-Normal--16-*-75-75-C-*-ISO8859-1"
"-Schumacher-Clean-Medium-R-Normal--17-*-75-75-C-*-ISO8859-1"
"-Schumacher-Clean-Medium-R-Normal--18-*-75-75-C-*-ISO8859-1"
"-Sony-Fixed-Medium-R-Normal--14-*-100-100-C-*-ISO8859-1"
"-Sony-Fixed-Medium-R-Normal--16-*-100-100-C-*-ISO8859-1"
"-Sony-Fixed-Medium-R-Normal--18-*-100-100-C-*-ISO8859-1"
"-Sony-Fixed-Medium-R-Normal--20-*-100-100-C-*-ISO8859-1"
"-B&H-LucidaTypewriter-Medium-R-Normal-Sans-14-*-100-100-M-*-ISO8859-1"
"-B&H-LucidaTypewriter-Medium-R-Normal-Sans-16-*-100-100-M-*-ISO8859-1"
"-B&H-LucidaTypewriter-Medium-R-Normal-Sans-18-*-100-100-M-*-ISO8859-1"
"-B&H-LucidaTypewriter-Bold-R-Normal-Sans-20-*-100-100-M-*-ISO8859-1"
"-B&H-LucidaTypewriter-Bold-R-Normal-Sans-24-*-100-100-M-*-ISO8859-1"
"-B&H-LucidaTypewriter-Bold-R-Normal-Sans-30-*-100-100-M-*-ISO8859-1"
"-B&H-LucidaTypewriter-Bold-R-Normal-Sans-34-*-100-100-M-*-ISO8859-1"
))
(defun font-next ()
(interactive)
(let ((len (length *font-ring*))
(next-index (+ *current-font-index* 1)))
(if (= next-index len)
(setq next-index 0))
(setq *current-font-index* next-index)
(message (concat "setting " (nth *current-font-index* *font-ring*)))
(set-default-font (nth *current-font-index* *font-ring*) t)
(set-frame-font (nth *current-font-index* *font-ring*) t)))
(defun font-prev ()
(interactive)
(let ((len (length *font-ring*))
(next-index (- *current-font-index* 1)))
(if (= next-index 0)
(setq next-index (- len 1)))
(setq *current-font-index* next-index)
(set-default-font (nth *current-font-index* *font-ring*) t)
(set-frame-font (nth *current-font-index* *font-ring*) t)))
(defun font-current ()
(interactive)
(cdr (assoc 'font (frame-parameters))))
(defun font-set (ix)
(setq *current-font-index* ix)
(set-default-font (nth *current-font-index* *font-ring*) t)
(set-frame-font (nth *current-font-index* *font-ring*) t))
(provide 'fontize)
I also bound these methods to keys, like this:
(global-set-key [?\C-+] 'inc-font-size)
(global-set-key [?\C--] 'dec-font-size)
(global-set-key [?\M-+] 'font-next)
(global-set-key [?\M--] 'font-prev)
Hope this helps someone in the same situation.
