(define *exactly-two-args?* '*)

(define custom-error-handler
  (let ((new-error-procedure
	  (letrec ((printer
		     (lambda (ls)
		       (if (pair? ls)
			   (begin
			     (display "       ")
			     (pp (car ls))
			     (newline)
			     (if (pair? (cdr ls))
				 (begin
				   (writeln "       " (cadr ls))
				   (printer (cddr ls)))))))))
	    (lambda (x y z)
	      (writeln "Error: " x)
	      (if (not (null? y))
                  (printer (if *exactly-two-args?* (list y) y)))
	      (newline) (reset))))
	(old-error-procedure error-procedure))
    (macro error
      (lambda (e)
	(let ((pieces (cdr e)))
	  (cond
	    ((null? pieces) 
	     (old-error-procedure 
	       "[Syntax Error] Expression has too few subexpressions"
	       '(error)
	       '()))
	    ((null? (cdr pieces)) `(error-procedure ,(car pieces) '() '()))
	    (else (let* ((two? (null? (cddr pieces)))
			 (arg (if two? (cadr pieces) `(list ,@(cdr pieces)))))
		    `(begin
		       (set! *exactly-two-args?* ,two?)
		       (error-procedure ,(car pieces) ,arg '()))))))))
    (lambda (bool)
      (set! (access *user-error-handler* user-global-environment)
	(lambda (err-num error-msg irritant sys-error-handler)
	  (if bool 
	      (begin 
		(newline)
		(display "Error: ")
		(writeln error-msg)
		(write irritant)
		(newline) (newline) (reset))
	      (sys-error-handler))))
      (set! error-procedure (if bool new-error-procedure old-error-procedure))
      (writeln (if bool "Custom" "System") " Error Handler Installed")
      *the-non-printing-object*)))

(custom-error-handler #t)