Some small improvements.

This commit is contained in:
Eli Barzilay 2011-08-29 22:12:07 -04:00
parent 187110cc2c
commit 14357370dd

View File

@ -94,35 +94,30 @@
(define col (syntax-column stx)) (define col (syntax-column stx))
(define source (syntax-source stx)) (define source (syntax-source stx))
(define pos (syntax-position stx)) (define pos (syntax-position stx))
(define str-src (cond (define str-src
[(path? source) (cond [(path? source)
(path->relative-string/library source)] (regexp-replace #rx"^<(.*?)>(?=/)"
[(string? source) (path->relative-string/library source)
source] (lambda (_ s) (string-upcase s)))]
[(string? source) source]
[else #f])) [else #f]))
(define str-loc (cond (define str-loc
[(and line col) (format "-~a-~a" line col)] (cond [(and line col) (format "-~a-~a" line col)]
[pos (format "--~a" pos)] [pos (format "--~a" pos)]
[else ""])) [else ""]))
(define combined-str (define combined-str (string-append (or str-src "rkttmp") str-loc))
(cond (define sanitized-str (regexp-replace* #rx"[<>:\"/\\|]" combined-str "-"))
[str-src (string-append str-src str-loc)] (define max-len 50) ;; must be even
[else (string-append "rkttmp" str-loc)]))
(define sanitized-str
(regexp-replace*
#rx"[<>]"
(regexp-replace* #rx"[\\/:]" combined-str "-")
""))
(define max-len 40) ;; must be even
(define not-too-long-str (define not-too-long-str
(cond (cond [(< max-len (string-length sanitized-str))
[(< max-len (string-length sanitized-str))
(string-append (substring sanitized-str 0 (- (/ max-len 2) 2)) (string-append (substring sanitized-str 0 (- (/ max-len 2) 2))
"..." "----"
(substring sanitized-str 0 (- (/ max-len 2) 1)))] (substring sanitized-str
[else (- (string-length sanitized-str)
sanitized-str])) (- (/ max-len 2) 2))))]
#`(app make-temporary-file/proc #,(string-append not-too-long-str "_~a")))] [else sanitized-str]))
#`(app make-temporary-file/proc
#,(string-append not-too-long-str "_~a")))]
[(_ . whatever) [(_ . whatever)
#'(app make-temporary-file/proc . whatever)]))) #'(app make-temporary-file/proc . whatever)])))