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

fix bug in menu label construction

Browse Source 
closes PR 13817
This commit is contained in:
Robby Findler 2013-06-04 14:29:52 -05:00
parent 1f22800d51
commit aaaebe2e41
1 changed files with 35 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
collects/drracket/private/unit.rkt
View File

@ -4086,26 +4086,13 @@ module browser threading seems wrong.
language-specific-menu language-specific-menu
(λ (x y) (drracket:module-overview:module-overview this))) (λ (x y) (drracket:module-overview:module-overview this)))
(let () (let ()
(define base-title (format (string-constant module-browser-in-file) ""))
(define (update-menu-item i) (define (update-menu-item i)
(define fn (send definitions-text get-filename)) (define fn (send definitions-text get-filename))
(send i set-label (define lab-str (compute-label-string fn))
(if fn (send i set-label lab-str)
(let* ([str (path->string fn)]
[overage (- 200
(+ (string-length str)
(string-length base-title)))])
(format (string-constant module-browser-in-file)
(if (overage . >= . 0)
str
(string-append "..."
(substring str
(+ (- (string-length str) (abs overage)) 3)
(string-length str))))))
(string-constant module-browser-no-file)))
(send i enable fn)) (send i enable fn))
(define i (new menu:can-restore-menu-item% (define i (new menu:can-restore-menu-item%
[label base-title] [label ""]
[parent language-specific-menu] [parent language-specific-menu]
[demand-callback update-menu-item] [demand-callback update-menu-item]
[callback (λ (x y) [callback (λ (x y)
@ -5209,3 +5196,35 @@ module browser threading seems wrong.
(send frame show #t) (send frame show #t)
(send (send frame get-interactions-text) initialize-console) (send (send frame get-interactions-text) initialize-console)
frame))) frame)))
(define/contract (compute-label-string fn)
(-> (or/c path? #f) label-string?)
(cond
[fn
(define base-title (format (string-constant module-browser-in-file) ""))
(define str (path->string fn))
(define limit (- 200 (string-length base-title)))
(define str-to-use
(if (<= (string-length str) limit)
str
(string-append "..."
(substring str
(+ (- (string-length str) limit) 3)
(string-length str)))))
(format (string-constant module-browser-in-file) str-to-use)]
[else (string-constant module-browser-no-file)]))
(module+ test
(require rackunit)
(check-equal? (compute-label-string (string->path "x"))
(format (string-constant module-browser-in-file) "x"))
(check-equal? (compute-label-string #f)
(string-constant module-browser-no-file))
(check-equal? (string-length (compute-label-string (string->path (make-string 200 #\x))))
200)
(for ([i (in-range 100 300)])
(let/ec k
(parameterize ([error-escape-handler k])
(check-true (string?
(compute-label-string
(string->path (make-string i #\x)))))))))