.edwin-x

;; Aesthetics for X-windows edwin
((ref-command set-foreground-color) "green")
((ref-command set-background-color) "black")
((ref-command set-mouse-color) "yellow")
((ref-command set-cursor-color) "red")

((ref-command set-font) "10x20")

((ref-command set-frame-size) 85 40)
((ref-command set-frame-position) 0 0)

(set-variable! enable-recursive-minibuffers true)

(set-variable! version-control true)

(set-variable! kept-new-versions 3)

(set-variable! buffer-menu-kill-on-quit true)

(set! x-screen-ignore-focus-button? #t)

(add-event-receiver! (ref-variable text-mode-hook) turn-on-auto-fill)

(modify-syntax-entry! text-mode:syntax-table #\" "\"")

(define-key 'fundamental (make-special-key 'F2 2) 'compare-windows)

(define-key 'inferior-repl '(#\C-c #\spc) 
  'comint-replace-by-expanded-filename)

(define-key 'scheme #\m-q 'comment-fill-paragraph)

(define-command comment-fill-paragraph
  "Fill the current comment as a paragraph.
Works only if point is inside a line containing only a comment."
  ()
  (lambda ()
    (if (not (ref-variable comment-locator-hook))
	(editor-error "No comment syntax defined"))
    (let ((start (line-start (current-point) 0)))
      (let ((com ((ref-variable comment-locator-hook) start)))
	(if (not (and com (line-start? (horizontal-space-start (car com)))))
	    (editor-error "Not on a comment line"))
	(with-variable-value!
	    (ref-variable-object paragraph-ignore-fill-prefix)
	    false
	  (lambda ()
	    (with-variable-value! (ref-variable-object fill-prefix)
				  (extract-string start (cdr com))
	      (lambda ()
		((ref-command fill-paragraph) (current-point) false)))))))))

(define-key 'scheme #\c-m-j 'indent-lisp-body)

(define-command indent-lisp-body
  "Indent the current line as if it were the body of a definition,
regardless of the normal indentation for the keyword."
  "p"
  (lambda (argument)
    (with-variable-value!
     (ref-variable-object lisp-indent-hook)
     (lambda (state indent-point normal-indent)
       indent-point normal-indent ;ignore
       (+ (ref-variable lisp-body-indent)
	  (mark-column (parse-state-containing-sexp state))))
     (lambda ()
       ((ref-command indent-for-tab-command) argument)))))


(string-table-put! scheme-mode:indent-methods "rule" 1)
(string-table-put! scheme-mode:indent-methods "let-cells" 1)
(string-table-put! scheme-mode:indent-methods "let&" 1)

(define-key 'inferior-repl '(#\C-c #\C-y) '(inferior-repl . #\M-p))
(define-command new-scheme-environment
  "Run an inferior read-eval-print loop (REPL), with I/O through
buffer *scheme*.  If buffer exists, just select it; otherwise create
it and start REPL.  NEW-SCHEME makes a new USER-INITIAL-ENVIRONMENT
evaluation environment, discarding the old one."
  ()
  (lambda ()
    (select-buffer
     (or (find-buffer initial-buffer-name)
	 (let ((current-buffer (current-buffer)))
	   (let ((environment
		  (in-package system-global-environment (make-environment))))
	     (set! user-initial-environment environment)
	     (let ((buffer (create-buffer initial-buffer-name)))
	       (start-inferior-repl! buffer
				     environment
				     (evaluation-syntax-table current-buffer
							      environment)
				     false)
	       buffer)))))))

(set! load-debugging-info-on-demand? #t)

(define fonts
  (list->vector
   (list "5x7" "5x8" "6x9" "6x10" "6x12" "6x13" "7x13" "7x14" "8x13"
	 "8x16" "9x15" "10x20" "12x24")))

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