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

..

Browse Source 
original commit: b50f69dbd9101a26e28f1b7891c3a056d282ecdb
This commit is contained in:
Robby Findler 2002-11-26 18:20:04 +00:00
parent 619dd4c842
commit 38f968bc27
3 changed files with 34 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -754,7 +754,7 @@
[define label ""]
[define label-prefix (application:current-app-name)]
(define (do-label)
(super-set-label (get-entire-label))
(super-set-label (gui-utils:trim-string (get-entire-label) 200))
(send (group:get-the-frame-group) frame-label-changed this))
(public get-entire-label get-label-prefix set-label-prefix)

5
collects/framework/private/group.ss
View File

@ -112,7 +112,8 @@
(for-each
(lambda (frame)
(let ([frame (frame-frame frame)])
(make-object menu-item% (get-name frame)
(make-object menu-item%
(gui-utils:trim-string (get-name frame) 200)
menu
(lambda (_1 _2)
(send frame show #t)))))
@ -301,7 +302,7 @@
[(d) (make-object dialog% (string-constant bring-frame-to-front) parent 400 600)]
[(lb) (instantiate list-box% ()
(label #f)
(choices (map (lambda (x) (send x get-label)) sorted-frames))
(choices (map (lambda (x) (gui-utils:trim-string (send x get-label) 200)) sorted-frames))
(callback (lambda (x y) (listbox-callback y)))
(parent d))]
[(t) (instantiate text:hide-caret/selection% ())]

55
collects/framework/private/text.ss
View File

@ -560,13 +560,13 @@
res))))
(rename [super-on-paint on-paint])
(inherit get-canvas)
(inherit get-canvases get-active-canvas has-focus?)
(define/override (on-paint before? dc left top right bottom dx dy draw-caret?)
(super-on-paint before? dc left top right bottom dx dy draw-caret?)
(unless before?
(let ([canvas (get-canvas)])
(when canvas
(send (send canvas get-top-level-window) delegate-moved)))))
(let ([active-canvas (get-active-canvas)])
(when active-canvas
(send (send active-canvas get-top-level-window) delegate-moved)))))
(rename [super-on-edit-sequence on-edit-sequence])
(define/override (on-edit-sequence)
@ -658,12 +658,16 @@
(run-after-edit-sequence
(rec from-enqueue-for-frame
(lambda ()
(let ([canvas (get-canvas)])
(when canvas
(let ([frame (send canvas get-top-level-window)])
(when (is-a? frame frame:text-info<%>)
(call-method frame)))))))
(call-with-frame call-method)))
tag))
(define (call-with-frame call-method)
(let ([canvas (get-canvas)])
(when canvas
(let ([frame (send canvas get-top-level-window)])
(when (is-a? frame frame:text-info<%>)
(call-method frame))))))
(override set-anchor set-overwrite-mode after-set-position after-insert after-delete)
(define (set-anchor x)
(super-set-anchor x)
@ -677,28 +681,29 @@
'framework:overwrite-status-changed))
(define (after-set-position)
(super-after-set-position)
(enqueue-for-frame
(lambda (x) (send x editor-position-changed))
'framework:editor-position-changed))
(maybe-queue-editor-position-update))
;; maybe-queue-editor-position-update : -> void
;; updates the editor-position in the frame,
;; but delays it until the next low-priority event occurs.
(field (callback-running? #f))
(define/private (maybe-queue-editor-position-update)
(unless callback-running?
(set! callback-running? #t)
(queue-callback
(lambda ()
(call-with-frame
(lambda (frame)
(send frame editor-position-changed)))
(set! callback-running? #f))
#f)))
(define (after-insert start len)
(super-after-insert start len)
(enqueue-for-frame
(lambda (x)
(unless callback-running?
(set! callback-running? #t)
(queue-callback
(lambda ()
(send x editor-position-changed)
(set! callback-running? #f))
#f)))
'framework:editor-position-changed))
(maybe-queue-editor-position-update))
(define (after-delete start len)
(super-after-delete start len)
(enqueue-for-frame
(lambda (x) (send x editor-position-changed))
'framework:editor-position-changed))
(maybe-queue-editor-position-update))
(super-instantiate ())))
(define clever-file-format<%> (interface ((class->interface text%))))