(col (assq-ref where 'column))) (format port "~a:~a:~a: " file line col)) (format port "unknown location: ")) (if who (format port "~a: " who)) (format port "~a" what) (if subform (format port " in subform ~s of ~s" subform form) (if form (format port " in form ~s" form)))) (_ (default-printer))) args)) (define (keyword-error-printer port key args default-printer) (let ((message (cadr args)) (faulty (car (cadddr args)))) ; I won't do it again, I promise. (format port "~a: ~s" message faulty))) (define (getaddrinfo-error-printer port key args default-printer) (format port "In procedure getaddrinfo: ~a" (gai-strerror (car args)))) (set-exception-printer! 'goops-error scm-error-printer) (set-exception-printer! 'host-not-found scm-error-printer) (set-exception-printer! 'keyword-argument-error keyword-error-printer) (set-exception-printer! 'misc-error scm-error-printer) (set-exception-printer! 'no-data scm-error-printer) (set-exception-printer! 'no-recovery scm-error-printer) (set-exception-printer! 'null-pointer-error scm-error-printer) (set-exception-printer! 'out-of-memory scm-error-printer) (set-exception-printer! 'out-of-range scm-error-printer) (set-exception-printer! 'program-error scm-error-printer) (set-exception-printer! 'read-error scm-error-printer) (set-exception-printer! 'regular-expression-syntax scm-error-printer) (set-exception-printer! 'signal scm-error-printer) (set-exception-printer! 'stack-overflow scm-error-printer) (set-exception-printer! 'system-error scm-error-printer) (set-exception-printer! 'try-again scm-error-printer) (set-exception-printer! 'unbound-variable scm-error-printer) (set-exception-printer! 'wrong-number-of-args scm-error-printer) (set-exception-printer! 'wrong-type-arg scm-error-printer) (set-exception-printer! 'syntax-error syntax-error-printer) (set-exception-printer! 'getaddrinfo-error getaddrinfo-error-printer))