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

{quick,merge}sort -> sort

Browse Source 
svn: r2569

original commit: 16f01a1109691d2fa4844b9411410f4794cf0dc1
This commit is contained in:
Eli Barzilay 2006-04-01 12:24:15 +00:00
parent 63e43c86aa
commit 869838e8ed
11 changed files with 36 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/embedded-gui/private/alignment.ss
View File

@ -87,9 +87,8 @@ neck and it is the most readable solution.
(let-values ([(total-unstretchable-size stretchable-sizes)
(get-onsizes rects)])
(let-values ([(extra-div extra-mod)
(get-extra/rect
(- onsize total-unstretchable-size)
(quicksort stretchable-sizes >))])
(get-extra/rect (- onsize total-unstretchable-size)
(sort stretchable-sizes >))])
(allocate-evenly/position extra-div extra-mod offsize rects))))
#;(((listof rect?)) . ->* . (nonnegative? (listof nonnegative?)))
@ -147,4 +146,4 @@ neck and it is the most readable solution.
(begin
(set! n (sub1 n))
1))))
)
)

2
collects/framework/private/finder.ss
View File

@ -100,7 +100,7 @@
(send name-list clear)
(send name-list set
(quicksort
(sort
(let ([no-periods?
(not (preferences:get
'framework:show-periods-in-dirlist))])

4
collects/framework/private/group.ss
View File

@ -81,7 +81,7 @@
default-name)
label)))]
[sorted/visible-frames
(quicksort
(sort
(filter (λ (x) (send (frame-frame x) is-shown?)) frames)
(λ (f1 f2)
(string-ci<=? (get-name (frame-frame f1))
@ -254,7 +254,7 @@
(define (choose-a-frame parent)
(letrec-values ([(sorted-frames)
(quicksort
(sort
(send (get-the-frame-group) get-frames)
(λ (x y) (string-ci<=? (send x get-label) (send y get-label))))]
[(d) (make-object dialog% (string-constant bring-frame-to-front) parent 400 600)]

6
collects/framework/private/handler.ss
View File

@ -303,9 +303,9 @@
(for-each (λ (item) (send hl delete-item item)) (send hl get-items))
(for-each (λ (item) (add-recent-item item))
(if (eq? (preferences:get 'framework:recently-opened-sort-by) 'name)
(quicksort recent-list-items
(λ (x y) (string<=? (path->string (car x))
(path->string (car y)))))
(sort recent-list-items
(λ (x y) (string<=? (path->string (car x))
(path->string (car y)))))
recent-list-items))
(send ed end-edit-sequence)))

2
collects/framework/private/scheme.ss
View File

@ -1222,7 +1222,7 @@
(letrec ([all-keywords (hash-table-map hash-table list)]
[pick-out (λ (wanted in out)
(cond
[(null? in) (quicksort out string<=?)]
[(null? in) (sort out string<=?)]
[else (if (eq? wanted (cadr (car in)))
(pick-out wanted (cdr in) (cons (symbol->string (car (car in))) out))
(pick-out wanted (cdr in) out))]))])

9
collects/hierlist/hierlist-unit.ss
View File

@ -7,7 +7,7 @@
(lib "include-bitmap.ss" "mrlib")
"hierlist-sig.ss")
(require (lib "list.ss")
(require (rename (lib "list.ss") sort* sort)
(lib "etc.ss"))
(define turn-up (include-bitmap "../icons/turn-up.png" 'png))
@ -395,9 +395,10 @@
(delete (if (zero? s) s (sub1 s)) (if (zero? s) (add1 e) e)))]
[else (loop (add1 pos) (cdr l) (cons (car l) others))])))]
[sort (opt-lambda (less-than? [recur? #t])
(let ([l (mergesort children (lambda (a b)
(less-than? (send a get-item)
(send b get-item))))])
(let ([l (sort* children
(lambda (a b)
(less-than? (send a get-item)
(send b get-item))))])
(begin-edit-sequence)
(when recur?
(for-each (lambda (child)

4
collects/mred/private/filedialog.ss
View File

@ -212,8 +212,8 @@
(let loop ([l l][ds null][fs null])
(cond
[(null? l) (values (cons (string->path "..")
(quicksort ds path-string-locale<?))
(quicksort fs path-string-locale<?))]
(sort ds path-string-locale<?))
(sort fs path-string-locale<?))]
[(and (not dot?)
(char=? (string-ref (path->string (car l)) 0) #\.))
(loop (cdr l) ds fs)]

24
collects/mred/private/fontdialog.ss
View File

@ -50,19 +50,17 @@
;; Sort space-starting first (for Xft), and
;; otherwise push names that start with an
;; ASCII non-letter/digit/hyphen to the end
(quicksort l (lambda (a b)
(let ([a-sp? (char=? #\space (string-ref a 0))]
[b-sp? (char=? #\space (string-ref b 0))]
[a-ugly? (ugly? a)]
[b-ugly? (ugly? b)])
(cond
[(eq? a-sp? b-sp?)
(cond
[(eq? a-ugly? b-ugly?)
(string-locale-ci<? a b)]
[else
b-ugly?])]
[else a-sp?])))))
(sort l (lambda (a b)
(let ([a-sp? (char=? #\space (string-ref a 0))]
[b-sp? (char=? #\space (string-ref b 0))]
[a-ugly? (ugly? a)]
[b-ugly? (ugly? b)])
(cond [(eq? a-sp? b-sp?)
(cond
[(eq? a-ugly? b-ugly?)
(string-locale-ci<? a b)]
[else b-ugly?])]
[else a-sp?])))))
p refresh-sample)]
[p2 (make-object vertical-pane% p)]
[p3 (instantiate horizontal-pane% (p2) [stretchable-width #f])]

2
collects/mrlib/private/aligned-pasteboard/alignment.ss
View File

@ -90,7 +90,7 @@ neck and it is the most readable solution.
(let-values ([(extra-div extra-mod)
(get-extra/rect
(- onsize total-unstretchable-size)
(quicksort stretchable-sizes >))])
(sort stretchable-sizes >))])
(allocate-evenly/position extra-div extra-mod offsize rects))))
;; get-onsizes (((listof rect?)) . ->* . (nonnegative? (listof nonnegative?)))

9
collects/mrlib/syntax-browser.ss
View File

@ -273,14 +273,13 @@ needed to really make this work:
(set! details-shown? #t)))
(let ([ranges
(quicksort
(apply append
(sort
(apply append
(hash-table-map
range-ht
(λ (k vs)
(map
(λ (v) (make-range k (car v) (cdr v)))
vs))))
(map (λ (v) (make-range k (car v) (cdr v)))
vs))))
(λ (x y)
(>= (- (range-end x) (range-start x))
(- (range-end y) (range-start y)))))])

7
collects/tests/mred/png.ss
View File

@ -11,10 +11,9 @@
"It should contain the PNG test files (including GIFs for comparisons).")))
(define l (map (lambda (f) (build-path png-suite f))
(quicksort
(filter (lambda (x) (regexp-match #rx"^[^x].*[.]png$" x))
(directory-list png-suite))
string<?)))
(sort (filter (lambda (x) (regexp-match #rx"^[^x].*[.]png$" x))
(directory-list png-suite))
string<?)))
(define (png->gif f)
(regexp-replace #rx"[.]png$" f ".gif"))