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

Some small improvements.

Browse Source
This commit is contained in:
Eli Barzilay 2011-08-29 22:12:07 -04:00
parent 187110cc2c
commit 14357370dd
1 changed files with 26 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
collects/racket/file.rkt
View File

@ -90,39 +90,34 @@
[x (identifier? #'x) #'make-temporary-file/proc] [x (identifier? #'x) #'make-temporary-file/proc]
[(_) [(_)
(let () (let ()
(define line (syntax-line stx)) (define line (syntax-line stx))
(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)))]
[else #f])) [(string? source) source]
(define str-loc (cond [else #f]))
[(and line col) (format "-~a-~a" line col)] (define str-loc
[pos (format "--~a" pos)] (cond [(and line col) (format "-~a-~a" line col)]
[else ""])) [pos (format "--~a" pos)]
(define combined-str [else ""]))
(cond (define combined-str (string-append (or str-src "rkttmp") str-loc))
[str-src (string-append str-src str-loc)] (define sanitized-str (regexp-replace* #rx"[<>:\"/\\|]" combined-str "-"))
[else (string-append "rkttmp" str-loc)])) (define max-len 50) ;; must be even
(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
(substring sanitized-str 0 (- (/ max-len 2) 1)))] (- (string-length sanitized-str)
[else (- (/ max-len 2) 2))))]
sanitized-str])) [else sanitized-str]))
#`(app make-temporary-file/proc #,(string-append not-too-long-str "_~a")))] #`(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)])))