suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

error

Browse Source 
svn: r3941
This commit is contained in:
Jay McCarthy 2006-08-03 16:46:25 +00:00
parent d9409858fd
commit 2fde0eeab7
1 changed files with 20 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
collects/web-server/response.ss
View File

@ -278,10 +278,6 @@
;; Turn an exn:invalid-xexpr into a response. ;; Turn an exn:invalid-xexpr into a response.
(define (xexpr-exn->response exn x) (define (xexpr-exn->response exn x)
;;; Does it matter what number I use for pretty-print-size-hook?
(pretty-print-size-hook (lambda (v display? op) 20))
(pretty-print-print-hook (pretty-print-hook/web-errors
(exn:invalid-xexpr-code exn)))
(make-response/full (make-response/full
500 "Servlet Error" 500 "Servlet Error"
(current-seconds) (current-seconds)
@ -295,27 +291,22 @@
"<pre>" (exn-message exn) "</pre>" "<pre>" (exn-message exn) "</pre>"
"<h2>The Full Xexpr Is</h2>" "<h2>The Full Xexpr Is</h2>"
"<pre>" "<pre>"
(let ((o (open-output-string))) (let ([o (open-output-string)])
(pretty-print x o) (parameterize ([current-output-port o])
(pretty-print-invalid-xexpr exn x))
(get-output-string o)) (get-output-string o))
"</pre>")))) "</pre>"))))
;; Format everything normally, except for the erroneous data. (define (pretty-print-invalid-xexpr exn xexpr)
(define (pretty-print-hook/web-errors err) (define code (exn:invalid-xexpr-code exn))
(letrec ((f-aux (lambda (v) (parameterize ([pretty-print-size-hook (lambda (v display? out)
(cond (and (equal? v code)
((equal? v err) (string-length (format (if display? "~a" "~v") v))))]
(format [pretty-print-print-hook (lambda (v display? out)
(fprintf out
(string-append (string-append
"<span style='font-weight: bold; " "<font color=\"red\">"
"color: red; background-color: white;'>" (if display? "~a" "~v")
"~a</span>") v)) "</font>")
((list? v) (string-append "(" v))])
(string-join (map f-aux v) (pretty-print xexpr))))
" ")
")"))
(else (format "~a" v))))))
(lambda (v display? op)
((if display? display write) (f-aux v) op))))
)