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

improved behavior of clicking on the line/column display (a little bit)

Browse Source 
svn: r4297
This commit is contained in:
Robby Findler 2006-09-10 21:14:56 +00:00
parent 287cd08bf8
commit cb6c8d00f3
1 changed files with 60 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -503,22 +503,14 @@
(set! rest-panel r-root) (set! rest-panel r-root)
r-root)) r-root))
[define info-canvas #f] (define info-canvas #f)
(public get-info-canvas set-info-canvas get-info-editor) (define/public (get-info-canvas) info-canvas)
[define get-info-canvas (define/public (set-info-canvas c) (set! info-canvas c))
(λ () (define/public (get-info-editor)
info-canvas)]
[define set-info-canvas
(λ (c)
(set! info-canvas c))]
[define get-info-editor
(λ ()
(and info-canvas (and info-canvas
(send info-canvas get-editor)))] (send info-canvas get-editor)))
(public determine-width) (define/public (determine-width string canvas edit)
[define determine-width
(λ (string canvas edit)
(send edit set-autowrap-bitmap #f) (send edit set-autowrap-bitmap #f)
(send canvas call-as-primary-owner (send canvas call-as-primary-owner
(λ () (λ ()
@ -532,9 +524,9 @@
(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))) (+ magic-space (- (inexact->exact (floor (unbox rb)))
(inexact->exact (floor (unbox lb))))))))))] (inexact->exact (floor (unbox lb))))))))))
[define outer-info-panel 'top-info-panel-uninitialized] (define outer-info-panel 'top-info-panel-uninitialized)
;; this flag is specific to this frame ;; this flag is specific to this frame
;; the true state of the info panel is ;; the true state of the info panel is
@ -598,31 +590,24 @@
(when (send lock-canvas is-shown?) (when (send lock-canvas is-shown?)
(send lock-canvas show #f))]))) (send lock-canvas show #f))])))
(public update-info) (define/public (update-info) (lock-status-changed))
[define update-info
(λ ()
(lock-status-changed))]
(super-new) (super-new)
(set! outer-info-panel (make-object horizontal-panel% super-root)) (set! outer-info-panel (make-object horizontal-panel% super-root))
(send outer-info-panel stretchable-height #f) (send outer-info-panel stretchable-height #f)
[define info-panel (make-object horizontal-panel% outer-info-panel)] (define info-panel (new horizontal-panel% [parent outer-info-panel]))
(make-object grow-box-spacer-pane% outer-info-panel) (new grow-box-spacer-pane% [parent outer-info-panel])
(public get-info-panel)
[define get-info-panel (define/public (get-info-panel) info-panel)
(λ () (define/public (update-memory-text)
info-panel)]
(public update-memory-text)
[define update-memory-text
(λ ()
(when show-memory-text? (when show-memory-text?
(send memory-text begin-edit-sequence) (send memory-text begin-edit-sequence)
(send memory-text lock #f) (send memory-text lock #f)
(send memory-text erase) (send memory-text erase)
(send memory-text insert (format-number (current-memory-use))) (send memory-text insert (format-number (current-memory-use)))
(send memory-text lock #t) (send memory-text lock #t)
(send memory-text end-edit-sequence)))] (send memory-text end-edit-sequence)))
(define/private (format-number n) (define/private (format-number n)
(let loop ([n n]) (let loop ([n n])
@ -700,22 +685,22 @@
(define text-info-mixin (define text-info-mixin
(mixin (info<%>) (text-info<%>) (mixin (info<%>) (text-info<%>)
(inherit get-info-editor) (inherit get-info-editor)
[define remove-first (define remove-first
(preferences:add-callback (preferences:add-callback
'framework:col-offsets 'framework:col-offsets
(λ (p v) (λ (p v)
(editor-position-changed-offset/numbers (editor-position-changed-offset/numbers
v v
(preferences:get 'framework:display-line-numbers)) (preferences:get 'framework:display-line-numbers))
#t))] #t)))
[define remove-second (define remove-second
(preferences:add-callback (preferences:add-callback
'framework:display-line-numbers 'framework:display-line-numbers
(λ (p v) (λ (p v)
(editor-position-changed-offset/numbers (editor-position-changed-offset/numbers
(preferences:get 'framework:col-offsets) (preferences:get 'framework:col-offsets)
v) v)
#t))] #t)))
(define/augment (on-close) (define/augment (on-close)
(remove-first) (remove-first)
(remove-second) (remove-second)
@ -869,13 +854,20 @@
b b
(string-constant auto-extend-selection))) (string-constant auto-extend-selection)))
(get-info-panel))] (get-info-panel))]
[define overwrite-message (define overwrite-message
(make-object message% (new message%
(string-constant overwrite) [label (string-constant overwrite)]
(get-info-panel))] [parent (get-info-panel)]))
[define position-canvas (make-object click-pref-editor-canvas% (get-info-panel) #f '(no-hscroll no-vscroll))]
[define position-edit (make-object text%)]
(define position-parent (new click-pref-panel%
[border 2]
[parent (get-info-panel)]
[stretchable-width #f]
[stretchable-height #f]))
(define position-canvas (new editor-canvas%
[parent position-parent]
[style '(no-hscroll no-vscroll)]))
(define position-edit (new text%))
(define macro-recording-message (define macro-recording-message
(instantiate message% () (instantiate message% ()
@ -895,7 +887,7 @@
(move-front (move-front
overwrite-message overwrite-message
(move-front (move-front
position-canvas position-parent
l))))))) l)))))))
(send macro-recording-message show #f) (send macro-recording-message show #f)
(send anchor-message show #f) (send anchor-message show #f)
@ -912,10 +904,10 @@
(send position-edit hide-caret #t) (send position-edit hide-caret #t)
(send position-edit lock #t))) (send position-edit lock #t)))
(define click-pref-editor-canvas% (define click-pref-panel%
(class editor-canvas% (class horizontal-panel%
(inherit popup-menu) (inherit popup-menu)
(define/override (on-event evt) (define/override (on-subwindow-event receiver evt)
(cond (cond
[(send evt button-down? 'right) [(send evt button-down? 'right)
(let ([menu (new popup-menu%)] (let ([menu (new popup-menu%)]
@ -932,9 +924,10 @@
[checked (not line-numbers?)]) [checked (not line-numbers?)])
(popup-menu menu (popup-menu menu
(+ 1 (send evt get-x)) (+ 1 (send evt get-x))
(+ 1 (send evt get-y))))] (+ 1 (send evt get-y))))
#t]
[else [else
(super on-event evt)])) (super on-subwindow-event receiver evt)]))
(super-new))) (super-new)))
(define pasteboard-info<%> (interface (info<%>))) (define pasteboard-info<%> (interface (info<%>)))