.
original commit: eb8561bb851e12c113aabac364a26cd4c446364c
This commit is contained in:
parent
ccb86c681f
commit
eb7bfa19bb
|
@ -11,7 +11,8 @@
|
||||||
(unit/sig framework:canvas^
|
(unit/sig framework:canvas^
|
||||||
(import mred^
|
(import mred^
|
||||||
[preferences : framework:preferences^]
|
[preferences : framework:preferences^]
|
||||||
[frame : framework:frame^])
|
[frame : framework:frame^]
|
||||||
|
[text : framework:text^])
|
||||||
|
|
||||||
(rename [-color% color%])
|
(rename [-color% color%])
|
||||||
|
|
||||||
|
@ -71,16 +72,10 @@
|
||||||
add-wide-snip
|
add-wide-snip
|
||||||
add-tall-snip))
|
add-tall-snip))
|
||||||
|
|
||||||
;; wx: this needs to collude with
|
|
||||||
;; the edit, since the edit has the right callbacks.
|
|
||||||
(define wide-snip-mixin
|
(define wide-snip-mixin
|
||||||
(mixin (basic<%>) (wide-snip<%>)
|
(mixin (basic<%>) (wide-snip<%>)
|
||||||
(inherit get-editor)
|
(inherit get-editor)
|
||||||
[define wide-snips null]
|
(define/private ((update-snip-size width?) s)
|
||||||
[define tall-snips null]
|
|
||||||
[define update-snip-size
|
|
||||||
(lambda (width?)
|
|
||||||
(lambda (s)
|
|
||||||
(let* ([width (box 0)]
|
(let* ([width (box 0)]
|
||||||
[height (box 0)]
|
[height (box 0)]
|
||||||
[leftm (box 0)]
|
[leftm (box 0)]
|
||||||
|
@ -162,20 +157,26 @@
|
||||||
(unbox bottomm)))])
|
(unbox bottomm)))])
|
||||||
(send* s
|
(send* s
|
||||||
(set-min-height snip-height)
|
(set-min-height snip-height)
|
||||||
(set-max-height snip-height)))))))))))]
|
(set-max-height snip-height))))))))))
|
||||||
(public recalc-snips add-wide-snip add-tall-snip)
|
(define/public (recalc-snips)
|
||||||
[define recalc-snips
|
(let ([editor (get-editor)])
|
||||||
(lambda ()
|
(unless (is-a? editor text:wide-snip<%>)
|
||||||
(for-each (update-snip-size #t) wide-snips)
|
(error 'recalc-snips "expected a text:wide-snip<%> editor, instead ~e" editor))
|
||||||
(for-each (update-snip-size #f) tall-snips))]
|
(when (eq? (send editor get-canvas) this)
|
||||||
[define add-wide-snip
|
(for-each (update-snip-size #t) (send editor get-wide-snips))
|
||||||
(lambda (snip)
|
(for-each (update-snip-size #f) (send editor get-tall-snips)))))
|
||||||
(set! wide-snips (cons snip wide-snips))
|
(define/public (add-wide-snip snip)
|
||||||
((update-snip-size #t) snip))]
|
(let ([editor (get-editor)])
|
||||||
[define add-tall-snip
|
(unless (is-a? editor text:wide-snip<%>)
|
||||||
(lambda (snip)
|
(error 'add-wide-snip "expected to have a text:wide-snip<%> editor, instead ~e" editor))
|
||||||
(set! tall-snips (cons snip tall-snips))
|
(send editor add-wide-snip snip))
|
||||||
((update-snip-size #f) snip))]
|
((update-snip-size #t) snip))
|
||||||
|
(define/public (add-tall-snip snip)
|
||||||
|
(let ([editor (get-editor)])
|
||||||
|
(unless (is-a? editor text:wide-snip<%>)
|
||||||
|
(error 'add-wide-snip "expected to have a text:wide-snip<%> editor, instead ~e" editor))
|
||||||
|
(send editor add-tall-snip snip))
|
||||||
|
((update-snip-size #f) snip))
|
||||||
(define/override (on-size width height)
|
(define/override (on-size width height)
|
||||||
(recalc-snips)
|
(recalc-snips)
|
||||||
(super on-size width height))
|
(super on-size width height))
|
||||||
|
|
|
@ -300,6 +300,7 @@
|
||||||
hide-caret/selection<%>
|
hide-caret/selection<%>
|
||||||
nbsp->space<%>
|
nbsp->space<%>
|
||||||
delegate<%>
|
delegate<%>
|
||||||
|
wide-snip<%>
|
||||||
searching<%>
|
searching<%>
|
||||||
return<%>
|
return<%>
|
||||||
info<%>
|
info<%>
|
||||||
|
@ -327,6 +328,7 @@
|
||||||
foreground-color-mixin
|
foreground-color-mixin
|
||||||
hide-caret/selection-mixin
|
hide-caret/selection-mixin
|
||||||
nbsp->space-mixin
|
nbsp->space-mixin
|
||||||
|
wide-snip-mixin
|
||||||
delegate-mixin
|
delegate-mixin
|
||||||
searching-mixin
|
searching-mixin
|
||||||
return-mixin
|
return-mixin
|
||||||
|
|
|
@ -429,7 +429,22 @@ WARNING: printf is rebound in the body of the unit to always
|
||||||
(char=? cr-code code))
|
(char=? cr-code code))
|
||||||
(return))
|
(return))
|
||||||
(super on-local-char key))))
|
(super on-local-char key))))
|
||||||
(super-instantiate ())))
|
(super-new)))
|
||||||
|
|
||||||
|
(define wide-snip<%>
|
||||||
|
(interface (basic<%>)
|
||||||
|
add-wide-snip
|
||||||
|
add-tall-snip))
|
||||||
|
|
||||||
|
(define wide-snip-mixin
|
||||||
|
(mixin (basic<%>) (wide-snip<%>)
|
||||||
|
(define wide-snips '())
|
||||||
|
(define tall-snips '())
|
||||||
|
(define/public (add-wide-snip s) (set! wide-snips (cons s wide-snips)))
|
||||||
|
(define/public (get-wide-snips) wide-snips)
|
||||||
|
(define/public (add-tall-snip s) (set! tall-snips (cons s tall-snips)))
|
||||||
|
(define/public (get-tall-snips) tall-snips)
|
||||||
|
(super-new)))
|
||||||
|
|
||||||
(define delegate<%> (interface (basic<%>)
|
(define delegate<%> (interface (basic<%>)
|
||||||
get-delegate
|
get-delegate
|
||||||
|
@ -1772,7 +1787,7 @@ WARNING: printf is rebound in the body of the unit to always
|
||||||
(define hide-caret/selection% (hide-caret/selection-mixin basic%))
|
(define hide-caret/selection% (hide-caret/selection-mixin basic%))
|
||||||
(define nbsp->space% (nbsp->space-mixin basic%))
|
(define nbsp->space% (nbsp->space-mixin basic%))
|
||||||
(define delegate% (delegate-mixin basic%))
|
(define delegate% (delegate-mixin basic%))
|
||||||
(define standard-style-list% (editor:standard-style-list-mixin basic%))
|
(define standard-style-list% (editor:standard-style-list-mixin (wide-snip-mixin basic%)))
|
||||||
(define -keymap% (editor:keymap-mixin standard-style-list%))
|
(define -keymap% (editor:keymap-mixin standard-style-list%))
|
||||||
(define return% (return-mixin -keymap%))
|
(define return% (return-mixin -keymap%))
|
||||||
(define autowrap% (editor:autowrap-mixin -keymap%))
|
(define autowrap% (editor:autowrap-mixin -keymap%))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user