Caps REPL history using string length rather than entry count

This commit is contained in:
Casey Klein 2010-12-02 14:18:26 -06:00
parent ab82bc04eb
commit 5bb45d787f

View File

@ -437,7 +437,6 @@ TODO
(define-struct sexp (left right prompt)) (define-struct sexp (left right prompt))
(define console-max-save-previous-exprs 30)
(let* ([list-of? (λ (p?) (let* ([list-of? (λ (p?)
(λ (l) (λ (l)
(and (list? l) (and (list? l)
@ -449,8 +448,7 @@ TODO
'drracket:console-previous-exprs 'drracket:console-previous-exprs
null null
list-of-lists-of-snip/strings?)) list-of-lists-of-snip/strings?))
(let ([marshall (define (marshall-previous-exprs lls)
(λ (lls)
(map (λ (ls) (map (λ (ls)
(list (list
(apply (apply
@ -463,11 +461,11 @@ TODO
[(string? s) s] [(string? s) s]
[else "'non-string-snip"])) [else "'non-string-snip"]))
ls))))) ls)))))
lls))] lls))
[unmarshall (λ (x) x)]) (let ([unmarshall (λ (x) x)])
(preferences:set-un/marshall (preferences:set-un/marshall
'drracket:console-previous-exprs 'drracket:console-previous-exprs
marshall unmarshall)) marshall-previous-exprs unmarshall))
(define color? ((get-display-depth) . > . 8)) (define color? ((get-display-depth) . > . 8))
@ -1771,8 +1769,23 @@ TODO
(define/private (add-to-previous-exprs snips) (define/private (add-to-previous-exprs snips)
(set! local-previous-exprs (append local-previous-exprs (list snips)))) (set! local-previous-exprs (append local-previous-exprs (list snips))))
; list-of-lists-of-snip/strings? -> list-of-lists-of-snip/strings?
(define/private (trim-previous-exprs lst) (define/private (trim-previous-exprs lst)
(take-right lst (min (length lst) console-max-save-previous-exprs))) (define max-size 10000)
(define (expr-size expr)
(for/fold ([s 0]) ([e expr]) (+ s (string-length e))))
(define within-bound
(let loop ([marshalled (reverse (marshall-previous-exprs lst))]
[keep 0]
[sum 0])
(if (empty? marshalled)
keep
(let* ([size (expr-size (first marshalled))]
[w/another (+ size sum)])
(if (> w/another max-size)
keep
(loop (rest marshalled) (add1 keep) w/another))))))
(take-right lst within-bound))
(define/private (save-interaction-in-history start end) (define/private (save-interaction-in-history start end)
(split-snip start) (split-snip start)