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

svn: r11408

Browse Source
This commit is contained in:
Robby Findler 2008-08-25 02:21:29 +00:00
parent e58bf78f04
commit 6a2b6a10be
1 changed files with 19 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
collects/drscheme/private/first-line-text.ss
View File

@ -66,20 +66,24 @@ The on-event method isnt' working right yet.
(send (send this get-canvas) refresh))) (send (send this get-canvas) refresh)))
(define/override (on-event event) (define/override (on-event event)
(let ([y (send event get-y)] (cond
[h (fetch-first-line-height)]) [(or (send event moving?)
(cond (send event leaving?)
[(and (< y h) (send event entering?))
(not (or (send event moving?) (super on-event event)]
(send event leaving?) [else
(send event entering?))) (let ([y (send event get-y)]
(let ([admin (get-admin)]) [h (fetch-first-line-height)]
(and admin [admin (get-admin)])
(begin (send admin get-view #f by #f #f #f) (unless admin (send admin get-view #f by #f #f #f))
(= (unbox by) 0))))) (cond
(scroll-to #f (send event get-x) 0 0 0 #f)] [(and (< y h)
[else admin
(super on-event event)]))) (not (= (unbox by) 0)))
(send admin scroll-to (send event get-x) 0 0 0 #t)
(super on-event event)]
[else
(super on-event event)]))]))
(define/override (on-paint before? dc left top right bottom dx dy draw-caret) (define/override (on-paint before? dc left top right bottom dx dy draw-caret)
@ -143,6 +147,7 @@ The on-event method isnt' working right yet.
(super-new))) (super-new)))
#;
(begin (begin
(define f (new frame% [label ""] [width 200] [height 200])) (define f (new frame% [label ""] [width 200] [height 200]))
(define t (new (editor:standard-style-list-mixin (first-line-text-mixin text%)))) (define t (new (editor:standard-style-list-mixin (first-line-text-mixin text%))))