Class contracts for racket/snip.
This commit is contained in:
Asumu Takikawa
parent
303110583b
commit
2e1d59f7b2
|
|
@ -1,12 +1,27 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
(require "snip/private/snip.rkt"
|
(require racket/contract/base
|
||||||
|
"snip/contracts.rkt"
|
||||||
|
"snip/private/snip.rkt"
|
||||||
"snip/private/snip-admin.rkt"
|
"snip/private/snip-admin.rkt"
|
||||||
"snip/private/style.rkt")
|
"snip/private/style.rkt")
|
||||||
|
|
||||||
(provide mult-color<%>
|
(provide mult-color<%>
|
||||||
add-color<%>
|
add-color<%>
|
||||||
style-delta%
|
|
||||||
style<%>
|
style<%>
|
||||||
style-list%
|
|
||||||
the-style-list
|
the-style-list
|
||||||
(all-from-out "snip/private/snip.rkt"
|
|
||||||
"snip/private/snip-admin.rkt"))
|
(except-out (all-from-out "snip/private/snip.rkt")
|
||||||
|
snip%
|
||||||
|
snip-class%
|
||||||
|
string-snip%
|
||||||
|
tab-snip%
|
||||||
|
image-snip%))
|
||||||
|
|
||||||
|
(provide/contract [style-delta% style-delta%/c]
|
||||||
|
[style-list% style-list%/c]
|
||||||
|
[snip% snip%/c]
|
||||||
|
[snip-class% snip-class%/c]
|
||||||
|
[string-snip% string-snip%/c]
|
||||||
|
[tab-snip% tab-snip%/c]
|
||||||
|
[image-snip% image-snip%/c]
|
||||||
|
[snip-admin% snip-admin%/c])
|
||||||
|
|
|
||||||
583
collects/racket/snip/contracts.rkt
Normal file
583
collects/racket/snip/contracts.rkt
Normal file
|
|
@ -0,0 +1,583 @@
|
||||||
|
#lang racket
|
||||||
|
|
||||||
|
(require racket/class
|
||||||
|
racket/draw
|
||||||
|
"private/snip.rkt"
|
||||||
|
"private/snip-admin.rkt"
|
||||||
|
"private/style.rkt")
|
||||||
|
|
||||||
|
(provide (all-defined-out))
|
||||||
|
|
||||||
|
;; dummy definitions for contracts
|
||||||
|
(define-values (cursor% mouse-event% key-event% pasteboard%
|
||||||
|
editor-stream-in% editor-stream-out% text% popup-menu%)
|
||||||
|
(values object% object% object% object%
|
||||||
|
object% object% object% object%))
|
||||||
|
|
||||||
|
;; interfaces:
|
||||||
|
(define (equal<%>/c cls)
|
||||||
|
(class/c
|
||||||
|
(equal-to? (->m (is-a?/c cls) (-> any/c any/c boolean?) boolean?))
|
||||||
|
(equal-hash-code-of (->m (-> any/c exact-integer?) exact-integer?))
|
||||||
|
(equal-secondary-hash-code-of (->m (-> any/c exact-integer?) exact-integer?))
|
||||||
|
(override
|
||||||
|
(equal-to? (->m (is-a?/c cls) (-> any/c any/c boolean?) boolean?))
|
||||||
|
(equal-hash-code-of (->m (-> any/c exact-integer?) exact-integer?))
|
||||||
|
(equal-secondary-hash-code-of (->m (-> any/c exact-integer?) exact-integer?)))))
|
||||||
|
|
||||||
|
(define readable-snip<%>/c
|
||||||
|
(class/c
|
||||||
|
(read-special
|
||||||
|
(->m any/c
|
||||||
|
(or/c exact-nonnegative-integer? #f)
|
||||||
|
(or/c exact-nonnegative-integer? #f)
|
||||||
|
(or/c exact-nonnegative-integer? #f)
|
||||||
|
any/c))))
|
||||||
|
|
||||||
|
;; contract utilities:
|
||||||
|
(define font-family/c
|
||||||
|
(or/c 'base 'default 'decorative 'roman 'script
|
||||||
|
'swiss 'modern 'symbol 'system))
|
||||||
|
|
||||||
|
(define font-smoothing/c
|
||||||
|
(or/c 'base 'default 'partly-smoothed 'smoothed 'unsmoothed))
|
||||||
|
|
||||||
|
(define font-style/c
|
||||||
|
(or/c 'base 'normal 'italic 'slant))
|
||||||
|
|
||||||
|
(define font-weight/c
|
||||||
|
(or/c 'base 'normal 'bold 'light))
|
||||||
|
|
||||||
|
(define alignment/c
|
||||||
|
(or/c 'base 'top 'center 'bottom))
|
||||||
|
|
||||||
|
(define tab-snip-filetype/c
|
||||||
|
(one-of/c 'unknown 'unknown/mask 'unknown/alpha
|
||||||
|
'gif 'gif/mask 'gif/alpha
|
||||||
|
'jpeg 'png 'png/mask 'png/alpha
|
||||||
|
'xbm 'xpm 'bmp 'pict))
|
||||||
|
|
||||||
|
(define style-delta%/c
|
||||||
|
(class/c
|
||||||
|
(collapse (->m (is-a?/c style-delta%) boolean?))
|
||||||
|
(copy (->m (is-a?/c style-delta%) void?))
|
||||||
|
(equal? (->m (is-a?/c style-delta%) boolean?))
|
||||||
|
(get-alignment-off (->m alignment/c))
|
||||||
|
(get-alignment-on (->m alignment/c))
|
||||||
|
(get-background-add (->m (is-a?/c add-color<%>)))
|
||||||
|
(get-background-mult (->m (is-a?/c mult-color<%>)))
|
||||||
|
(get-face (->m (or/c string? false/c)))
|
||||||
|
(get-family (->m font-family/c))
|
||||||
|
(get-foreground-add (->m (is-a?/c add-color<%>)))
|
||||||
|
(get-foreground-mult (->m (is-a?/c mult-color<%>)))
|
||||||
|
(get-size-add (->m (integer-in 0 255)))
|
||||||
|
(get-size-in-pixels-off (->m boolean?))
|
||||||
|
(get-size-in-pixels-on (->m boolean?))
|
||||||
|
(get-size-mult (->m real?))
|
||||||
|
(get-smoothing-off (->m font-smoothing/c))
|
||||||
|
(get-style-off (->m font-style/c))
|
||||||
|
(get-style-on (->m font-style/c))
|
||||||
|
(get-transparent-text-backing-off (->m boolean?))
|
||||||
|
(get-transparent-text-backing-on (->m boolean?))
|
||||||
|
(get-underlined-off (->m boolean?))
|
||||||
|
(get-underlined-on (->m boolean?))
|
||||||
|
(get-weight-off (->m font-weight/c))
|
||||||
|
(get-weight-on (->m font-weight/c))
|
||||||
|
(set-alignment-off (->m alignment/c void?))
|
||||||
|
(set-alignment-on (->m alignment/c void?))
|
||||||
|
(set-delta (case->m
|
||||||
|
(-> (is-a?/c style-delta%))
|
||||||
|
(-> (or/c 'change-nothing
|
||||||
|
'change-normal
|
||||||
|
'change-toggle-underline
|
||||||
|
'change-toggle-size-in-pixels
|
||||||
|
'change-normal-color
|
||||||
|
'change-italic
|
||||||
|
'change-bold)
|
||||||
|
(is-a?/c style-delta%))
|
||||||
|
(-> (or/c 'change-family
|
||||||
|
'change-style
|
||||||
|
'change-toggle-style
|
||||||
|
'change-weight
|
||||||
|
'change-toggle-weight
|
||||||
|
'change-smoothing
|
||||||
|
'change-toggle-smoothing
|
||||||
|
'change-alignment
|
||||||
|
'change-size
|
||||||
|
'change-bigger
|
||||||
|
'change-smaller
|
||||||
|
'change-underline
|
||||||
|
'change-size-in-pixels)
|
||||||
|
any/c
|
||||||
|
(is-a?/c style-delta%))))
|
||||||
|
(set-delta-background (->m (or/c string? (is-a?/c color%))
|
||||||
|
(is-a?/c style-delta%)))
|
||||||
|
(set-delta-face (->*m (string?) (font-family/c) (is-a?/c style-delta%)))
|
||||||
|
(set-delta-foreground (->m (or/c string? (is-a?/c color%))
|
||||||
|
(is-a?/c style-delta%)))
|
||||||
|
(set-face (->m (or/c string? false/c) void?))
|
||||||
|
(set-family (->m font-family/c void?))
|
||||||
|
(set-size-add (->m (integer-in 0 255) void?))
|
||||||
|
(set-size-in-pixels-off (->m any/c void?))
|
||||||
|
(set-size-in-pixels-on (->m any/c void?))
|
||||||
|
(set-size-mult (->m real? void?))
|
||||||
|
(set-smoothing-off (->m font-smoothing/c void?))
|
||||||
|
(set-smoothing-on (->m font-smoothing/c void?))
|
||||||
|
(set-style-off (->m font-style/c void?))
|
||||||
|
(set-style-on (->m font-style/c void?))
|
||||||
|
(set-transparent-text-backing-off (->m any/c void?))
|
||||||
|
(set-transparent-text-backing-on (->m any/c void?))
|
||||||
|
(set-underlined-off (->m any/c void?))
|
||||||
|
(set-underlined-on (->m any/c void?))
|
||||||
|
(set-weight-off (->m font-weight/c void?))
|
||||||
|
(set-weight-on (->m font-weight/c void?))))
|
||||||
|
|
||||||
|
(define style-list%/c
|
||||||
|
(class/c
|
||||||
|
(basic-style (->m (is-a?/c style<%>)))
|
||||||
|
(convert (->m (is-a?/c style<%>) (is-a?/c style<%>)))
|
||||||
|
(find-named-style (->m string? (or/c (is-a?/c style<%>) false/c)))
|
||||||
|
(find-or-create-join-style (->m (is-a?/c style<%>) (is-a?/c style<%>) (is-a?/c style<%>)))
|
||||||
|
(find-or-create-style (->m (is-a?/c style<%>) (is-a?/c style-delta%) (is-a?/c style<%>)))
|
||||||
|
(forget-notification (->m any/c void?))
|
||||||
|
(index-to-style (->m exact-nonnegative-integer? (or/c (is-a?/c style<%>) false/c)))
|
||||||
|
(new-named-style (->m string? (is-a?/c style<%>) (is-a?/c style<%>)))
|
||||||
|
(notify-on-change (->m (-> (or/c (is-a?/c style<%>) false/c) any) any/c))
|
||||||
|
(number (->m exact-nonnegative-integer?))
|
||||||
|
(replace-named-style (->m string? (is-a?/c style<%>) (is-a?/c style<%>)))
|
||||||
|
(style-to-index (->m (is-a?/c style<%>) (or/c exact-nonnegative-integer? false/c)))))
|
||||||
|
|
||||||
|
;; snip% utils
|
||||||
|
(define snip%-edit-operation/c
|
||||||
|
(one-of/c 'undo 'redo 'clear 'cut
|
||||||
|
'copy 'paste 'kill 'select-all
|
||||||
|
'insert-text-box 'insert-pasteboard-box 'insert-image))
|
||||||
|
|
||||||
|
;; snip% methods
|
||||||
|
(define snip%-adjust-cursor/c
|
||||||
|
(->m (is-a?/c dc<%>)
|
||||||
|
real?
|
||||||
|
real?
|
||||||
|
real?
|
||||||
|
real?
|
||||||
|
(is-a?/c mouse-event%)
|
||||||
|
(or/c (is-a?/c cursor%) false/c)))
|
||||||
|
|
||||||
|
(define snip%-blink-caret/c
|
||||||
|
(->m (is-a?/c dc<%>) real? real? void?))
|
||||||
|
|
||||||
|
(define snip%-can-do-edit-operation/c
|
||||||
|
(->*m (snip%-edit-operation/c)
|
||||||
|
(any/c)
|
||||||
|
boolean?))
|
||||||
|
|
||||||
|
(define snip%-copy/c
|
||||||
|
(->m (is-a?/c snip%)))
|
||||||
|
|
||||||
|
(define snip%-draw/c
|
||||||
|
(->m (is-a?/c dc<%>)
|
||||||
|
real?
|
||||||
|
real?
|
||||||
|
real?
|
||||||
|
real?
|
||||||
|
real?
|
||||||
|
real?
|
||||||
|
real?
|
||||||
|
real?
|
||||||
|
(one-of/c 'no-caret 'show-inactive-caret 'show-caret)
|
||||||
|
void?))
|
||||||
|
|
||||||
|
(define snip%-other-equal-to?/c
|
||||||
|
(->m (is-a?/c snip%) (-> any/c any/c boolean?) boolean?))
|
||||||
|
|
||||||
|
(define snip%-find-scroll-step/c
|
||||||
|
(->m real? exact-nonnegative-integer?))
|
||||||
|
|
||||||
|
(define snip%-get-admin/c
|
||||||
|
(->m (or/c (is-a?/c snip-admin%) false/c)))
|
||||||
|
|
||||||
|
(define snip%-get-count/c
|
||||||
|
(->m exact-nonnegative-integer?))
|
||||||
|
|
||||||
|
(define snip%-get-extent/c
|
||||||
|
(->*m ((is-a?/c dc<%>) real? real?)
|
||||||
|
((or/c (box/c (>=/c 0)) false/c)
|
||||||
|
(or/c (box/c (>=/c 0)) false/c)
|
||||||
|
(or/c (box/c (>=/c 0)) false/c)
|
||||||
|
(or/c (box/c (>=/c 0)) false/c)
|
||||||
|
(or/c (box/c (>=/c 0)) false/c)
|
||||||
|
(or/c (box/c (>=/c 0)) false/c))
|
||||||
|
void?))
|
||||||
|
|
||||||
|
(define snip%-get-extent-override/c
|
||||||
|
(->m (is-a?/c dc<%>)
|
||||||
|
real?
|
||||||
|
real?
|
||||||
|
(or/c (box/c (>=/c 0)) false/c)
|
||||||
|
(or/c (box/c (>=/c 0)) false/c)
|
||||||
|
(or/c (box/c (>=/c 0)) false/c)
|
||||||
|
(or/c (box/c (>=/c 0)) false/c)
|
||||||
|
(or/c (box/c (>=/c 0)) false/c)
|
||||||
|
(or/c (box/c (>=/c 0)) false/c)
|
||||||
|
void?))
|
||||||
|
|
||||||
|
(define snip%-get-flags/c
|
||||||
|
(->m (listof symbol?)))
|
||||||
|
|
||||||
|
(define snip%-get-num-scroll-steps/c
|
||||||
|
(->m exact-nonnegative-integer?))
|
||||||
|
|
||||||
|
(define snip%-get-scroll-step-offset/c
|
||||||
|
(->m exact-nonnegative-integer?
|
||||||
|
(>=/c 0)))
|
||||||
|
|
||||||
|
(define snip%-get-snipclass/c
|
||||||
|
(->m (or/c #f (is-a?/c snip-class%))))
|
||||||
|
|
||||||
|
(define snip%-get-style/c
|
||||||
|
(->m (is-a?/c style<%>)))
|
||||||
|
|
||||||
|
(define snip%-get-text/c
|
||||||
|
(->*m (exact-nonnegative-integer? exact-nonnegative-integer?)
|
||||||
|
(any/c)
|
||||||
|
string?))
|
||||||
|
|
||||||
|
(define snip%-get-text-override/c
|
||||||
|
(->m exact-nonnegative-integer?
|
||||||
|
exact-nonnegative-integer?
|
||||||
|
any/c
|
||||||
|
string?))
|
||||||
|
|
||||||
|
(define snip%-get-text!/c
|
||||||
|
(->m
|
||||||
|
(and/c string? (not/c immutable?))
|
||||||
|
exact-nonnegative-integer?
|
||||||
|
exact-nonnegative-integer?
|
||||||
|
exact-nonnegative-integer?
|
||||||
|
void?))
|
||||||
|
|
||||||
|
(define snip%-is-owned?/c
|
||||||
|
(->m boolean?))
|
||||||
|
|
||||||
|
(define snip%-match?/c
|
||||||
|
(->m (is-a?/c snip%) boolean?))
|
||||||
|
|
||||||
|
(define snip%-merge-with/c
|
||||||
|
(->m (is-a?/c snip%) (or/c (is-a?/c snip%) false/c)))
|
||||||
|
|
||||||
|
(define snip%-next/c
|
||||||
|
(->m (or/c (is-a?/c snip%) false/c)))
|
||||||
|
|
||||||
|
(define snip%-on-char/c
|
||||||
|
(->m (is-a?/c dc<%>)
|
||||||
|
real? real? real? real?
|
||||||
|
(is-a?/c key-event%)
|
||||||
|
void?))
|
||||||
|
|
||||||
|
(define snip%-on-event/c
|
||||||
|
(->m (is-a?/c dc<%>)
|
||||||
|
real? real? real? real?
|
||||||
|
(is-a?/c mouse-event%)
|
||||||
|
void?))
|
||||||
|
|
||||||
|
(define snip%-own-caret/c
|
||||||
|
(->m any/c void?))
|
||||||
|
|
||||||
|
(define snip%-partial-offset/c
|
||||||
|
(->m (is-a?/c dc<%>)
|
||||||
|
real? real?
|
||||||
|
exact-nonnegative-integer?
|
||||||
|
real?))
|
||||||
|
|
||||||
|
(define snip%-previous/c
|
||||||
|
(->m (or/c (is-a?/c snip%) false/c)))
|
||||||
|
|
||||||
|
(define snip%-release-from-owner/c
|
||||||
|
(->m boolean?))
|
||||||
|
|
||||||
|
(define snip%-resize/c
|
||||||
|
(->m (>=/c 0)
|
||||||
|
(>=/c 0)
|
||||||
|
boolean?))
|
||||||
|
|
||||||
|
(define snip%-set-admin/c
|
||||||
|
(->m (or/c (is-a?/c snip-admin%) false/c) void?))
|
||||||
|
|
||||||
|
(define snip%-set-count/c
|
||||||
|
(->m exact-positive-integer? void?))
|
||||||
|
|
||||||
|
(define snip%-set-flags/c
|
||||||
|
(->m (listof symbol?) void?))
|
||||||
|
|
||||||
|
(define snip%-set-snipclass/c
|
||||||
|
(->m (is-a?/c snip-class%) void?))
|
||||||
|
|
||||||
|
(define snip%-set-style/c
|
||||||
|
(->m (is-a?/c style<%>) void?))
|
||||||
|
|
||||||
|
(define snip%-set-unmodified/c
|
||||||
|
(->m void?))
|
||||||
|
|
||||||
|
(define snip%-size-cache-invalid/c
|
||||||
|
(->m void?))
|
||||||
|
|
||||||
|
(define snip%-split/c
|
||||||
|
(->m exact-nonnegative-integer?
|
||||||
|
(box/c (is-a?/c snip%))
|
||||||
|
(box/c (is-a?/c snip%))
|
||||||
|
void?))
|
||||||
|
|
||||||
|
(define snip%-write/c
|
||||||
|
(->m (is-a?/c editor-stream-out%) void?))
|
||||||
|
|
||||||
|
;; snip% class contract
|
||||||
|
(define snip%/c
|
||||||
|
(and/c
|
||||||
|
(equal<%>/c snip%)
|
||||||
|
(class/c
|
||||||
|
(adjust-cursor snip%-adjust-cursor/c)
|
||||||
|
(blink-caret snip%-blink-caret/c)
|
||||||
|
(can-do-edit-operation? snip%-can-do-edit-operation/c)
|
||||||
|
(copy snip%-copy/c)
|
||||||
|
(draw snip%-draw/c)
|
||||||
|
(other-equal-to? snip%-other-equal-to?/c)
|
||||||
|
(find-scroll-step snip%-find-scroll-step/c)
|
||||||
|
(get-admin snip%-get-admin/c)
|
||||||
|
(get-count snip%-get-count/c)
|
||||||
|
(get-extent snip%-get-extent/c)
|
||||||
|
(get-flags snip%-get-flags/c)
|
||||||
|
(get-num-scroll-steps snip%-get-num-scroll-steps/c)
|
||||||
|
(get-scroll-step-offset snip%-get-scroll-step-offset/c)
|
||||||
|
(get-snipclass snip%-get-snipclass/c)
|
||||||
|
(get-style snip%-get-style/c)
|
||||||
|
(get-text snip%-get-text/c)
|
||||||
|
(get-text! snip%-get-text!/c)
|
||||||
|
(is-owned? snip%-is-owned?/c)
|
||||||
|
(match? snip%-match?/c)
|
||||||
|
(merge-with snip%-merge-with/c)
|
||||||
|
(next snip%-next/c)
|
||||||
|
(on-char snip%-on-char/c)
|
||||||
|
(on-event snip%-on-event/c)
|
||||||
|
(own-caret snip%-own-caret/c)
|
||||||
|
(partial-offset snip%-partial-offset/c)
|
||||||
|
(previous snip%-previous/c)
|
||||||
|
(release-from-owner snip%-release-from-owner/c)
|
||||||
|
(resize snip%-resize/c)
|
||||||
|
(set-admin snip%-set-admin/c)
|
||||||
|
(set-count snip%-set-count/c)
|
||||||
|
(set-flags snip%-set-flags/c)
|
||||||
|
(set-snipclass snip%-set-snipclass/c)
|
||||||
|
(set-style snip%-set-style/c)
|
||||||
|
(set-unmodified snip%-set-unmodified/c)
|
||||||
|
(size-cache-invalid snip%-size-cache-invalid/c)
|
||||||
|
(split snip%-split/c)
|
||||||
|
(write snip%-write/c)
|
||||||
|
(override
|
||||||
|
(adjust-cursor snip%-adjust-cursor/c)
|
||||||
|
(draw snip%-draw/c)
|
||||||
|
(other-equal-to? snip%-other-equal-to?/c)
|
||||||
|
(find-scroll-step snip%-find-scroll-step/c)
|
||||||
|
(get-extent snip%-get-extent-override/c)
|
||||||
|
(get-num-scroll-steps snip%-get-num-scroll-steps/c)
|
||||||
|
(get-scroll-step-offset snip%-get-scroll-step-offset/c)
|
||||||
|
(get-text snip%-get-text-override/c)
|
||||||
|
(get-text! snip%-get-text!/c)
|
||||||
|
(match? snip%-match?/c)
|
||||||
|
(merge-with snip%-merge-with/c)
|
||||||
|
(on-char snip%-on-char/c)
|
||||||
|
(on-event snip%-on-event/c)
|
||||||
|
(own-caret snip%-own-caret/c)
|
||||||
|
(partial-offset snip%-partial-offset/c)
|
||||||
|
(release-from-owner snip%-release-from-owner/c)
|
||||||
|
(resize snip%-resize/c)
|
||||||
|
(set-count snip%-set-count/c)
|
||||||
|
(set-flags snip%-set-flags/c)
|
||||||
|
(set-unmodified snip%-set-unmodified/c)
|
||||||
|
(size-cache-invalid snip%-size-cache-invalid/c)
|
||||||
|
(split snip%-split/c)))))
|
||||||
|
|
||||||
|
|
||||||
|
;; snip-class% method contracts
|
||||||
|
(define snip-class%-get-classname/c
|
||||||
|
(->m string?))
|
||||||
|
|
||||||
|
(define snip-class%-get-version/c
|
||||||
|
(->m exact-integer?))
|
||||||
|
|
||||||
|
(define snip-class%-read/c
|
||||||
|
(->m (is-a?/c editor-stream-in%)
|
||||||
|
(or/c (is-a?/c snip%) false/c)))
|
||||||
|
|
||||||
|
(define snip-class%-read-header/c
|
||||||
|
(->m (is-a?/c editor-stream-in%) boolean?))
|
||||||
|
|
||||||
|
(define snip-class%-reading-version/c
|
||||||
|
(->m (is-a?/c editor-stream-in%) exact-integer?))
|
||||||
|
|
||||||
|
(define snip-class%-set-classname/c
|
||||||
|
(->m string? void?))
|
||||||
|
|
||||||
|
(define snip-class%-set-version/c
|
||||||
|
(->m exact-integer? void?))
|
||||||
|
|
||||||
|
(define snip-class%-write-header/c
|
||||||
|
(->m (is-a?/c editor-stream-out%) boolean?))
|
||||||
|
|
||||||
|
;; snip-class% class contract
|
||||||
|
(define snip-class%/c
|
||||||
|
(class/c
|
||||||
|
(get-classname snip-class%-get-classname/c)
|
||||||
|
(get-version snip-class%-get-version/c)
|
||||||
|
(read snip-class%-read/c)
|
||||||
|
(read-header snip-class%-read-header/c)
|
||||||
|
(reading-version snip-class%-reading-version/c)
|
||||||
|
(set-classname snip-class%-set-classname/c)
|
||||||
|
(set-version snip-class%-set-version/c)
|
||||||
|
(write-header snip-class%-write-header/c)
|
||||||
|
(override
|
||||||
|
(read snip-class%-read/c)
|
||||||
|
(read-header snip-class%-read-header/c)
|
||||||
|
(write-header snip-class%-write-header/c))))
|
||||||
|
|
||||||
|
(define string-snip%/c
|
||||||
|
(class/c
|
||||||
|
(insert (->*m (string? exact-nonnegative-integer?)
|
||||||
|
(exact-nonnegative-integer?)
|
||||||
|
void?))
|
||||||
|
(read (->m exact-nonnegative-integer?
|
||||||
|
(is-a?/c editor-stream-in%)
|
||||||
|
void?))))
|
||||||
|
|
||||||
|
(define tab-snip%/c
|
||||||
|
(class/c))
|
||||||
|
|
||||||
|
(define image-snip%/c
|
||||||
|
(class/c
|
||||||
|
(equal-hash-code-of (->m (any/c . -> . exact-integer?) exact-integer?))
|
||||||
|
(equal-secondary-hash-code-of (->m (any/c . -> . exact-integer?) exact-integer?))
|
||||||
|
(get-bitmap (->m (or/c (is-a?/c bitmap%) #f)))
|
||||||
|
(get-bitmap-mask (->m (or/c (is-a?/c bitmap%) #f)))
|
||||||
|
(get-filename (->*m () ((or/c (box/c any/c) #f)) (or/c path-string? #f)))
|
||||||
|
(get-filetype (->m tab-snip-filetype/c))
|
||||||
|
(load-file (->*m ((or/c path-string? input-port? #f))
|
||||||
|
(tab-snip-filetype/c any/c any/c)
|
||||||
|
void?))
|
||||||
|
(other-equal-to? (->m (is-a?/c image-snip%)
|
||||||
|
(any/c any/c . -> . boolean?)
|
||||||
|
boolean?))
|
||||||
|
(resize (->m (>=/c 0)
|
||||||
|
(>=/c 0)
|
||||||
|
boolean?))
|
||||||
|
(set-bitmap (->*m ((is-a?/c bitmap%)) ((or/c (is-a?/c bitmap%) #f)) void?))
|
||||||
|
(set-offset (->m real? real? void?))))
|
||||||
|
|
||||||
|
;; snip-admin% method contracts
|
||||||
|
(define snip-admin%-get-view/c
|
||||||
|
(->*m ((or/c (box/c real?) false/c)
|
||||||
|
(or/c (box/c real?) false/c)
|
||||||
|
(or/c (box/c (>=/c 0)) false/c)
|
||||||
|
(or/c (box/c (>=/c 0)) false/c))
|
||||||
|
((or/c (is-a?/c snip%) false/c))
|
||||||
|
void?))
|
||||||
|
|
||||||
|
(define snip-admin%-get-view-size/c
|
||||||
|
(->m (or/c (box/c (>=/c 0)) false/c)
|
||||||
|
(or/c (box/c (>=/c 0)) false/c)
|
||||||
|
void?))
|
||||||
|
|
||||||
|
(define snip-admin%-modified/c
|
||||||
|
(->m (is-a?/c snip%) any/c void?))
|
||||||
|
|
||||||
|
(define snip-admin%-needs-update/c
|
||||||
|
(->m (is-a?/c snip%)
|
||||||
|
real?
|
||||||
|
real?
|
||||||
|
(>=/c 0)
|
||||||
|
(>=/c 0)
|
||||||
|
void?))
|
||||||
|
|
||||||
|
(define snip-admin%-popup-menu/c
|
||||||
|
(->m (is-a?/c popup-menu%)
|
||||||
|
(is-a?/c snip%)
|
||||||
|
real?
|
||||||
|
real?
|
||||||
|
boolean?))
|
||||||
|
|
||||||
|
(define snip-admin%-recounted/c
|
||||||
|
(->m (is-a?/c snip%) any/c void?))
|
||||||
|
|
||||||
|
(define snip-admin%-release-snip/c
|
||||||
|
(->m (is-a?/c snip%) boolean?))
|
||||||
|
|
||||||
|
(define snip-admin%-resized/c
|
||||||
|
(->m (is-a?/c snip%) any/c void?))
|
||||||
|
|
||||||
|
(define snip-admin%-scroll-to/c
|
||||||
|
(->*m ((is-a?/c snip%)
|
||||||
|
real?
|
||||||
|
real?
|
||||||
|
(>=/c 0)
|
||||||
|
(>=/c 0)
|
||||||
|
any/c)
|
||||||
|
((one-of/c 'start 'end 'none))
|
||||||
|
boolean?))
|
||||||
|
|
||||||
|
(define snip-admin%-set-caret-owner/c
|
||||||
|
(->m (is-a?/c snip%)
|
||||||
|
(one-of/c 'immediate 'display 'global)
|
||||||
|
void?))
|
||||||
|
|
||||||
|
(define snip-admin%-update-cursor/c
|
||||||
|
(->m void?))
|
||||||
|
|
||||||
|
(define snip-admin%-get-line-spacing/c
|
||||||
|
(->m (>=/c 0)))
|
||||||
|
|
||||||
|
(define snip-admin%-get-selected-text-color/c
|
||||||
|
(->m (or/c (is-a?/c color%) #f)))
|
||||||
|
|
||||||
|
(define snip-admin%-call-with-busy-cursor/c
|
||||||
|
(->m (-> any) any))
|
||||||
|
|
||||||
|
(define snip-admin%-get-tabs/c
|
||||||
|
(->*m ()
|
||||||
|
((or/c (box/c exact-nonnegative-integer?) false/c)
|
||||||
|
(or/c (box/c real?) false/c)
|
||||||
|
(or/c (box/c real?) false/c))
|
||||||
|
(listof real?)))
|
||||||
|
|
||||||
|
(define snip-admin%/c
|
||||||
|
(class/c
|
||||||
|
(get-dc (->m (or/c (is-a?/c dc<%>) false/c)))
|
||||||
|
(get-editor (->m (or/c (is-a?/c text%) (is-a?/c pasteboard%))))
|
||||||
|
(get-view snip-admin%-get-view/c)
|
||||||
|
(get-view-size snip-admin%-get-view-size/c)
|
||||||
|
(modified snip-admin%-modified/c)
|
||||||
|
(needs-update snip-admin%-needs-update/c)
|
||||||
|
(popup-menu snip-admin%-popup-menu/c)
|
||||||
|
(recounted snip-admin%-recounted/c)
|
||||||
|
(release-snip snip-admin%-release-snip/c)
|
||||||
|
(resized snip-admin%-resized/c)
|
||||||
|
(scroll-to snip-admin%-scroll-to/c)
|
||||||
|
(set-caret-owner snip-admin%-set-caret-owner/c)
|
||||||
|
(update-cursor snip-admin%-update-cursor/c)
|
||||||
|
(get-line-spacing snip-admin%-get-line-spacing/c)
|
||||||
|
(get-selected-text-color snip-admin%-get-selected-text-color/c)
|
||||||
|
(call-with-busy-cursor snip-admin%-call-with-busy-cursor/c)
|
||||||
|
(get-tabs snip-admin%-get-tabs/c)
|
||||||
|
(override
|
||||||
|
(get-view snip-admin%-get-view/c)
|
||||||
|
(get-view-size snip-admin%-get-view-size/c)
|
||||||
|
(modified snip-admin%-modified/c)
|
||||||
|
(needs-update snip-admin%-needs-update/c)
|
||||||
|
(popup-menu snip-admin%-popup-menu/c)
|
||||||
|
(recounted snip-admin%-recounted/c)
|
||||||
|
(release-snip snip-admin%-release-snip/c)
|
||||||
|
(resized snip-admin%-resized/c)
|
||||||
|
(scroll-to snip-admin%-scroll-to/c)
|
||||||
|
(set-caret-owner snip-admin%-set-caret-owner/c)
|
||||||
|
(update-cursor snip-admin%-update-cursor/c)
|
||||||
|
(get-line-spacing snip-admin%-get-line-spacing/c)
|
||||||
|
(get-selected-text-color snip-admin%-get-selected-text-color/c)
|
||||||
|
(call-with-busy-cursor snip-admin%-call-with-busy-cursor/c)
|
||||||
|
(get-tabs snip-admin%-get-tabs/c))))
|
||||||
Loading…
Reference in New Issue
Block a user