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

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

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