From 68f34502b87463b0d2e24bfe84983a4868166a1d Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Wed, 15 Jun 2011 11:38:47 +0800 Subject: [PATCH] add a cache to avoid calling normalize-path so often when switching tabs closes PR 11936 --- collects/drracket/private/unit.rkt | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/collects/drracket/private/unit.rkt b/collects/drracket/private/unit.rkt index bffd9b4cbf..2bce25307c 100644 --- a/collects/drracket/private/unit.rkt +++ b/collects/drracket/private/unit.rkt @@ -2095,7 +2095,30 @@ module browser threading seems wrong. (get-tab-label-from-filename fn) (send defs get-filename/untitled-name)))) + ;; tab-label-cache-valid : (listof path) + ;; If the current set of filenames in the tabs is the + ;; same set of filenames as in this list, then the + ;; tab-label-cache is valid; otherwise not + (define tab-label-cache-valid '()) + + ;; tab-label-cache : path -o> string + (define tab-label-cache (make-hasheq)) + (define/private (get-tab-label-from-filename fn) + (define current-paths (map (lambda (tab) (send (send tab get-defs) get-filename)) + tabs)) + (unless (and (= (length tab-label-cache-valid) (length current-paths)) + (andmap eq? tab-label-cache-valid current-paths)) + (set! tab-label-cache-valid current-paths) + (set! tab-label-cache (make-hasheq))) + (hash-ref tab-label-cache + fn + (lambda () + (define ans (compute-tab-label-from-filename fn)) + (hash-set! tab-label-cache fn ans) + ans))) + + (define/private (compute-tab-label-from-filename fn) (let* ([take-n (λ (n lst) (let loop ([n n]