gistfile1.txt

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;    Firefox-like font resizing    ;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define fonts
  (list->vector
   (list "5x7" "5x8" "6x9" "6x10" "6x12" "6x13" "7x13" "7x14" "8x13"
         "8x16" "9x15" "10x20" "11x22" "14x28" "16x32" 
         "-xos4-terminus-medium-r-normal--22-220-72-72-c-110-microsoft-cp1251"
         "-gnu-unifont csur-medium-r-normal-sans-0-0-75-75-c-0-iso10646-1"
         "-gnu-unifont csur-medium-r-normal-sans-16-160-75-75-c-80-iso10646-1"
         "-gnu-unifont sample-medium-r-normal-sans-0-0-75-75-c-0-iso10646-1"
         "-gnu-unifont sample-medium-r-normal-sans-16-160-75-75-c-80-iso10646-1"
         "-gnu-unifont-medium-r-normal-sans-0-0-75-75-c-0-iso10646-1"
         "-gnu-unifont-medium-r-normal-sans-16-160-75-75-c-80-iso10646-1"
         )))
              

(define-variable default-font-index
  "default font size" 11)

(define-variable current-font-index
  "current font size" (ref-variable default-font-index))

(define (reset-frame-size)
  (let ((screen (selected-screen)))
    ((ref-command set-frame-size) (screen-x-size screen)
     (screen-y-size screen))))
  
(define ((shift-font-size! n))
  (let ((new-font-index  (+ (ref-variable current-font-index) n)))
    (if (< -1 new-font-index (vector-length fonts))
        (begin
          (set-variable! current-font-index new-font-index)
          ((ref-command set-font) 
           (vector-ref fonts (ref-variable current-font-index)))
          (reset-frame-size)))))
  
(define-command increment-font
  "Increase text size."
  () (shift-font-size! 1))

(define-command decrement-font
  "Decrease text size."
  () (shift-font-size! -1))

(define-command reset-font
  "Reset font size. see default-font-index variable."
  () 
  (lambda () 
    ((shift-font-size! 
      (- (ref-variable default-font-index)
         (ref-variable current-font-index))))))

(define-key 'fundamental #\c-+ 'increment-font)
(define-key 'fundamental #\c-- 'decrement-font)
(define-key 'fundamental #\c-= 'reset-font)

((ref-command reset-font))