måndag, november 13, 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.

4 kommentarer:

piyo sa...

I did something similiar to your font-size-ring, but for the purpose of being able to control the font size by Control-Mouse Wheel, which is also similar to the behavior of Microsoft Internet Explorer. You already have most of that functionality, all you have to do is change the bindings:

(global-set-key [C-mouse-wheel] 'inc-or-dec-font-size)

(defun inc-or-dec-font-size (event)
(interactive "e")
(let* ((position (event-start event))
(lines (nth 2 event))
(mouse-wheel-roll-up-p (> 0 lines))
...)
; based on mouse-wheel-roll-up-p, do inc-font-size or dec-font-size
...)

Anonym sa...

Two words: abstraction, DRY. See http://c2.com/cgi/wiki?AbstractWithOnceAndOnlyOnce

Ola Bini sa...

@piyo: well, you know... one of the main reasons I love emacs is that I don't need the mouse. but thanks for the tip anyway.

@anonymous: yeah, I know, as I said, I didn't spend much time on this, and I'm rusty on Emacs Lisp. it will certainly evolve when I have the time, but for now it works.

Ryan Davis sa...

font-ring can be replaced with (x-family-fonts). You could then add filters to include only the fonts you wanted based on regexp or something.