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

include a phase summary in module browser

Browse Source
This commit is contained in:
Robby Findler 2014-04-12 10:30:57 -05:00
parent c8df1184fd
commit 721750c27e
1 changed files with 73 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
pkgs/drracket-pkgs/drracket/drracket/private/module-browser.rkt
View File

@ -7,6 +7,9 @@
(require mred
racket/class
racket/set
racket/contract
racket/list
syntax/moddep
syntax/toplevel
framework/framework
@ -551,6 +554,7 @@
(inherit get-admin)
(define require-phases '())
(define/public (get-require-phases) require-phases)
(define/public (add-require-phase d)
(unless (member d require-phases)
(set! last-name #f)
@ -829,18 +833,25 @@
(define (update-found-and-search-hits reg)
(send pasteboard begin-edit-sequence)
(define count 0)
(define phases (set))
(let loop ([snip (send pasteboard find-first-snip)])
(when snip
(when (is-a? snip boxed-word-snip<%>)
(define found?
(and reg (regexp-match reg (path->string (send snip get-filename)))))
(when (or (not reg) found?) (set! count (+ count 1)))
(when (or (not reg) found?)
(for ([phase (in-list (send snip get-require-phases))])
(set! phases (set-add phases phase)))
(set! count (+ count 1)))
(send snip set-found! found?))
(loop (send snip next))))
(send search-hits set-label
(if reg
(format "~a found" count)
(format "~a total" count)))
(string-append
(if reg
(format "~a found" count)
(format "~a total" count))
(render-phases phases)))
(send pasteboard end-edit-sequence))
(update-found-and-search-hits #f) ;; only to initialize search-hits
@ -1032,7 +1043,65 @@
(super on-size w h))
(super-instantiate ()))))
(define/contract (render-phases s)
(-> (set/c (or/c exact-integer? #f)) string?)
(define for-doc (set-member? s #f))
(define lst (sort (filter number? (set->list s)) <))
(define joined-lst
(cond
[(null? lst) '()]
[else
(let loop ([lst (cdr lst)]
[pending-low (car lst)]
[pending-high (car lst)])
(cond
[(null? lst) (list (cons pending-low pending-high))]
[else
(define fst (car lst))
(cond
[(equal? (- fst 1) pending-high)
(loop (cdr lst)
pending-low
fst)]
[else
(cons (cons pending-low pending-high)
(loop (cdr lst) fst fst))])]))]))
(cond
[(and (null? joined-lst) (not for-doc))
""]
[(and (null? joined-lst) for-doc)
" (phase: for-label)"]
[else
(define plural? (not (= 1 (set-count s))))
(define strings
(append (for/list ([joined (in-list joined-lst)])
(cond
[(= (car joined) (cdr joined))
(format "~a" (car joined))]
[else
(format "~a–~a" (car joined) (cdr joined))]))
(if for-doc
'("for-label")
'())))
(apply string-append
(if plural? " (phases: " " (phase: ")
(append (add-between strings ", ")
'(")")))]))
(module+ test
(require rackunit)
(check-equal? (render-phases (set)) "")
(check-equal? (render-phases (set #f)) " (phase: for-label)")
(check-equal? (render-phases (set 1)) " (phase: 1)")
(check-equal? (render-phases (set -1 1)) " (phases: -1, 1)")
(check-equal? (render-phases (set -3 -2 -1 0 1 2 3)) " (phases: -3–3)")
(check-equal? (render-phases (set -3 -2 -1)) " (phases: -3–-1)")
(check-equal? (render-phases (set 1 3)) " (phases: 1, 3)")
(check-equal? (render-phases (set 1 2 3)) " (phases: 1–3)")
(check-equal? (render-phases (set 1 2 3 7 8 9)) " (phases: 1–3, 7–9)")
(check-equal? (render-phases (set #f 1 2 3 7 8 9)) " (phases: 1–3, 7–9, for-label)")
(check-equal? (render-phases (set 1 3 5 7 9)) " (phases: 1, 3, 5, 7, 9)")
(check-equal? (render-phases (set #f 1 3 5 7 9)) " (phases: 1, 3, 5, 7, 9, for-label)"))
;
;