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

avoid ugly nested conds

Browse Source 
Thanks, Laurent!

original commit: a8111ce91b5a8a1343310152c2b56323efe3d2fa
This commit is contained in:
Robby Findler 2013-06-12 05:18:12 -05:00
parent 60a84276cf
commit a4045a2c49
1 changed files with 10 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/framework/private/text.rkt
View File

@ -961,21 +961,16 @@
(send dc set-pen old-pen))))) (send dc set-pen old-pen)))))
(define/private (get-x-spot char-width) (define/private (get-x-spot char-width)
(cond (let/ec return
[char-width (unless char-width (return #f))
(define dc (get-dc)) (define dc (get-dc))
(cond (unless dc (return #f))
[dc
(define style (or (send (get-style-list) find-named-style "Standard") (define style (or (send (get-style-list) find-named-style "Standard")
(send (get-style-list) find-named-style "Basic"))) (send (get-style-list) find-named-style "Basic")))
(cond (unless style (return #f))
[style
(define fnt (send style get-font)) (define fnt (send style get-font))
(define-values (xw _1 _2 _3) (send dc get-text-extent "x" fnt)) (define-values (xw _1 _2 _3) (send dc get-text-extent "x" fnt))
(+ left-padding (* xw char-width))] (+ left-padding (* xw char-width))))))
[else #f])]
[else #f])]
[else #f]))))
(define normalize-paste<%> (interface ((class->interface text%)) (define normalize-paste<%> (interface ((class->interface text%))
ask-normalize? ask-normalize?