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

.

Browse Source 
original commit: f7cd5d5c9b32d47ad6747a23dcd9b79591369bdf
This commit is contained in:
Matthew Flatt 2004-02-03 20:48:42 +00:00
parent 78e36b0171
commit 97afafd887
1 changed files with 21 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
collects/mred/mred.ss
View File

@ -6741,15 +6741,24 @@
(send s set-delta (font->delta f))))))]
[p (make-object horizontal-pane% f)]
[face (make-object list-box% #f
(let ([l (wx:get-face-list)])
(if (memq (system-type) '(macos macosx))
(quicksort l (lambda (a b)
(let ([l (wx:get-face-list)]
[re:ugly-start #rxb"^[^a-zA-Z0-9\200-\377]"])
;; Sort space-starting first (for Xft), and
;; otherwise push names that start with an
;; ASCII non-letterdigit to the end
(quicksort l (lambda (a b)
(let ([a-sp? (char=? #\space (string-ref a 0))]
[b-sp? (char=? #\space (string-ref a 0))]
[a-ugly? (and (regexp-match re:ugly-start a) #t)]
[b-ugly? (and (regexp-match re:ugly-start b) #t)])
(cond
[(eq? a-sp? b-sp?)
(cond
[(eq? (char-alphabetic? (string-ref a 0))
(char-alphabetic? (string-ref b 0)))
(string-locale<? a b)]
[else (char-alphabetic? (string-ref a 0))])))
(quicksort l string-ci<?)))
[(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])]
@ -7107,7 +7116,10 @@
[else (constructor-name (cadr who))]))
(define (label-string? s)
(and (string? s) (<= 0 (string-length s) 200)))
(and (string? s)
(let ([l (string-unicode-length s)])
(and l
(<= 0 l 200)))))
(define (check-instance who class class-name false-ok? v)
(unless (or (and false-ok? (not v)) (is-a? v class))