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

made the line/column thingy growable and smaller to begin with

Browse Source 
svn: r5717
This commit is contained in:
Robby Findler 2007-03-02 13:50:23 +00:00
parent d52a97e0c2
commit eadc853016
1 changed files with 47 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
collects/framework/private/frame.ss
View File

@ -538,8 +538,9 @@
rb) rb)
(send edit position-location 0 lb) (send edit position-location 0 lb)
(send canvas min-width (send canvas min-width
(+ magic-space (- (inexact->exact (floor (unbox rb))) (+ (get-client-width/view-delta edit canvas)
(inexact->exact (floor (unbox lb)))))))))) (- (inexact->exact (floor (unbox rb)))
(inexact->exact (floor (unbox lb))))))))))
(define outer-info-panel 'top-info-panel-uninitialized) (define outer-info-panel 'top-info-panel-uninitialized)
@ -692,11 +693,18 @@
(spacing 3) (spacing 3)
(border 3)))) (border 3))))
(define text-info<%> (interface (info<%>) (define (get-client-width/view-delta position-edit position-canvas)
set-macro-recording (let ([admin (send position-edit get-admin)]
overwrite-status-changed [wb (box 0)])
anchor-status-changed (send admin get-view #f #f wb #f)
editor-position-changed)) (let-values ([(cw ch) (send position-canvas get-client-size)])
(inexact->exact (floor (- cw (unbox wb)))))))
(define text-info<%> (interface (info<%>)
set-macro-recording
overwrite-status-changed
anchor-status-changed
editor-position-changed))
(define text-info-mixin (define text-info-mixin
(mixin (info<%>) (text-info<%>) (mixin (info<%>) (text-info<%>)
(inherit get-info-editor) (inherit get-info-editor)
@ -752,16 +760,12 @@
(set! last-start start) (set! last-start start)
(set! last-end end) (set! last-end end)
(when (object? position-edit) (when (object? position-edit)
(send* position-edit (change-position-edit-contents
(lock #f) (if (= start end)
(erase) (make-one start)
(insert (string-append (make-one start)
(if (= start end) "-"
(make-one start) (make-one end)))))))]
(string-append (make-one start)
"-"
(make-one end))))
(lock #t)))))]
[else [else
(when (send position-canvas is-shown?) (when (send position-canvas is-shown?)
(send position-canvas show #f))]))) (send position-canvas show #f))])))
@ -872,6 +876,31 @@
[style '(no-hscroll no-vscroll)])) [style '(no-hscroll no-vscroll)]))
(define position-edit (new text%)) (define position-edit (new text%))
(define/private (change-position-edit-contents str)
(send position-edit begin-edit-sequence)
(send position-edit lock #f)
(send position-edit erase)
(send position-edit insert str)
(send position-canvas call-as-primary-owner
(λ ()
(let ([delta (get-client-width/view-delta position-edit position-canvas)]
[lb (box 0)]
[rb (box 0)])
(send position-edit position-location
(send position-edit last-position)
rb)
(send position-edit position-location 0 lb)
(let ([nw
(+ delta (- (inexact->exact (floor (unbox rb)))
(inexact->exact (floor (unbox lb)))))])
(when (< (send position-canvas min-client-width) nw)
(send position-canvas min-client-width nw))))))
(send position-edit lock #t)
(send position-edit end-edit-sequence))
(send (get-info-panel) change-children (send (get-info-panel) change-children
(λ (l) (λ (l)
(cons position-parent (remq position-parent l)))) (cons position-parent (remq position-parent l))))
@ -921,7 +950,7 @@
(set-editor position-edit) (set-editor position-edit)
(stretchable-width #f) (stretchable-width #f)
(stretchable-height #f)) (stretchable-height #f))
(determine-width "0000:000-0000:000" (determine-width "000:00-000:00"
position-canvas position-canvas
position-edit) position-edit)
(editor-position-changed) (editor-position-changed)