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

changed the ->d contracts to ->i contracts

Browse Source 
original commit: d419e8c12a554d660a65198dd102bc03e01c93a8
This commit is contained in:
Robby Findler 2010-09-09 14:16:56 -05:00
parent 189edf7686
commit a155727e09
3 changed files with 39 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
collects/framework/gui-utils.rkt
View File

@ -294,34 +294,38 @@
(provide/doc
(proc-doc
gui-utils:trim-string
(->d ([str string?][size (and/c number? positive?)])
(->i ([str string?]
[size (and/c number? positive?)])
()
[_ (and/c string?
(λ (str)
((string-length str) . <= . size)))])
[res (size)
(and/c string?
(λ (str)
((string-length str) . <= . size)))])
@{Constructs a string whose size is less
than @scheme[size] by trimming the @scheme[str]
and inserting an ellispses into it.})
(proc-doc
gui-utils:quote-literal-label
(->d ([str string?])
(->i ([str string?])
()
[_ (and/c string?
(lambda (str)
((string-length str) . <= . 200)))])
[res (str)
(and/c string?
(lambda (str)
((string-length str) . <= . 200)))])
@{Constructs a string whose ampersand characters are
escaped; the label is also trimmed to <= 200
characters.})
(proc-doc
gui-utils:format-literal-label
(->d ([str string?])
(->i ([str string?])
()
#:rest rest (listof any/c)
[_ (and/c string?
(lambda (str)
((string-length str) . <= . 200)))])
#:rest [rest (listof any/c)]
[res (str)
(and/c string?
(lambda (str)
((string-length str) . <= . 200)))])
@{Formats a string whose ampersand characters are
mk-escaped; the label is also trimmed to <= 200
mk-characters.})

16
collects/framework/main.rkt
View File

@ -195,15 +195,15 @@
(proc-doc/names
preferences:add-panel
(-> (or/c string? (cons/c string? (listof string?)))
(->d ([parent (is-a?/c area-container-window<%>)])
(->i ([parent (is-a?/c area-container-window<%>)])
()
[_
(let ([old-children (send parent get-children)])
(and/c (is-a?/c area-container-window<%>)
(λ (child)
(andmap eq?
(append old-children (list child))
(send parent get-children)))))])
[_ (parent)
(let ([old-children (send parent get-children)])
(and/c (is-a?/c area-container-window<%>)
(λ (child)
(andmap eq?
(append old-children (list child))
(send parent get-children)))))])
void?)
(labels f)
@{@scheme[preferences:add-preference-panel] adds the result of @scheme[f]

28
collects/mrlib/name-message.rkt
View File

@ -1,11 +1,23 @@
#lang racket/gui
(define (get-left-side-padding) (+ button-label-inset circle-spacer))
(define button-label-inset 1)
(define black-color (make-object color% "BLACK"))
(define triangle-width 10)
(define triangle-height 14)
(define triangle-color (make-object color% 50 50 50))
(define border-inset 1)
(define circle-spacer 4)
(define rrect-spacer 3)
(provide/contract
[get-left-side-padding (-> number?)]
[pad-xywh (-> number? number? (>=/c 0) (>=/c 0)
(values number? number? (>=/c 0) (>=/c 0)))]
[draw-button-label
(->d ([dc (is-a?/c dc<%>)]
(->i ([dc (is-a?/c dc<%>)]
[label (or/c false/c string?)]
[x number?]
[y number?]
@ -15,7 +27,7 @@
[grabbed? boolean?]
[button-label-font (is-a?/c font%)]
[bkg-color (or/c false/c (is-a?/c color%) string?)])
#:pre-cond
#:pre (w h)
(w . > . (- h (* 2 border-inset)))
[result void?])]
@ -214,18 +226,6 @@
(stretchable-height #f)
(send (get-dc) set-smoothing 'aligned)))
(define (get-left-side-padding) (+ button-label-inset circle-spacer))
(define button-label-inset 1)
(define black-color (make-object color% "BLACK"))
(define triangle-width 10)
(define triangle-height 14)
(define triangle-color (make-object color% 50 50 50))
(define border-inset 1)
(define circle-spacer 4)
(define rrect-spacer 3)
(define (offset-color color offset-one)
(make-object color%
(offset-one (send color red))