font zooming in emacs

font-size.el

;; font-size.el -- font zoomer
;; code from Ola Bini: http://ola-bini.blogspot.com/2006/11/emacs-diversion-font-sizes.html
;; replaced fonts with OSX fonts

(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* '(
                        "-apple-dejavu sans mono-medium-r-normal--14-0-72-72-m-0-iso10646-1"
                        "-apple-dejavu sans mono-medium-r-normal--15-0-72-72-m-0-iso10646-1"
                        "-apple-dejavu sans mono-medium-r-normal--17-0-72-72-m-0-iso10646-1"
                        "-apple-dejavu sans mono-medium-r-normal--18-0-72-72-m-0-iso10646-1"
                        "-apple-dejavu sans mono-medium-r-normal--20-0-72-72-m-0-iso10646-1"
                        "-apple-dejavu sans mono-medium-r-normal--22-0-72-72-m-0-iso10646-1"
                        "-apple-dejavu sans mono-medium-r-normal--24-0-72-72-m-0-iso10646-1"
                        "-apple-dejavu sans mono-medium-r-normal--25-0-72-72-m-0-iso10646-1"
                        "-apple-dejavu sans mono-medium-r-normal--26-0-72-72-m-0-iso10646-1"
                        "-apple-dejavu sans mono-medium-r-normal--28-0-72-72-m-0-iso10646-1"
                        "-apple-dejavu sans mono-medium-r-normal--30-0-72-72-m-0-iso10646-1"
                        "-apple-dejavu sans mono-medium-r-normal--32-0-72-72-m-0-iso10646-1"
                        "-apple-dejavu sans mono-medium-r-normal--34-0-72-72-m-0-iso10646-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))

(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)

(provide 'fontize)