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

..

Browse Source 
original commit: 94a2e2974b5d9b4274ad1d95243f6e553a8d2ee5
This commit is contained in:
Robby Findler 2003-01-30 17:18:46 +00:00
parent 1ad7fc6a52
commit 738ea87b63
2 changed files with 14 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -100,16 +100,6 @@
(parent menu)
(callback (lambda (x y) (most-recent-window-to-front)))
(shortcut #\'))
(instantiate menu:can-restore-menu-item% ()
(label (string-constant next-window))
(parent menu)
(callback (lambda (x y) (next/prev-window (send (send menu get-parent) get-frame) #t)))
(shortcut #\+))
(instantiate menu:can-restore-menu-item% ()
(label (string-constant previous-window))
(parent menu)
(callback (lambda (x y) (next/prev-window (send (send menu get-parent) get-frame) #f)))
(shortcut #\-))
(make-object separator-menu-item% menu)
(for-each
(lambda (frame)
@ -130,31 +120,7 @@
(define (most-recent-window-to-front)
(let ([most-recent-window (weak-box-value most-recent-window-box)])
(when most-recent-window
(send most-recent-window show #t))))
;; next/prev-window : (is-a?/c top-level-window<%>) boolean? -> void?
;; brings either the next or previous (alpabetically) window to the
;; front.
(define (next/prev-window this-window next?)
(let ([sorted
(quicksort
(get-frames)
(lambda (x y) (string-ci<=? (send x get-label) (send y get-label))))])
(let loop ([windows sorted]
[prev (car (last-pair sorted))])
(cond
[(null? windows) (void)]
[(eq? (car windows) this-window)
(let ([frame-to-focus
(if next?
(if (null? (cdr windows))
(car sorted)
(car (cdr windows)))
prev)])
(send frame-to-focus show #t))]
[else (loop (cdr windows)
(car windows))]))))
(send most-recent-window show #t))))
[define update-close-menu-item-state
(lambda ()
@ -224,7 +190,8 @@
[else (frame-frame (car frames))]))]
[define set-active-frame
(lambda (f)
(when active-frame
(when (and active-frame
(not (eq? active-frame f)))
(set! most-recent-window-box (make-weak-box active-frame)))
(set! active-frame f))]
[define insert-frame

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

@ -50,8 +50,8 @@
get-style-list is-modified? change-style set-modified
position-location get-extent)
(define highlight-pen (make-object pen% "BLACK" 0 'solid))
(define highlight-brush (make-object brush% "black" 'solid))
(define highlight-pen #f)
(define highlight-brush #f)
(define range-rectangles null)
(define ranges null)
@ -286,14 +286,18 @@
(let/ec k
(cond
[(and before color)
(send highlight-pen set-color color)
(send highlight-brush set-color color)]
(send dc set-pen (send the-pen-list find-or-create-pen color 0 'solid))
(send dc set-brush (send the-brush-list find-or-create-brush color 'solid))]
[(and (not before) (not color) b/w-bitmap)
(unless highlight-pen
(set! highlight-pen (make-object pen% "BLACK" 0 'solid)))
(unless highlight-brush
(set! highlight-brush (make-object brush% "black" 'solid)))
(send highlight-pen set-stipple b/w-bitmap)
(send highlight-brush set-stipple b/w-bitmap)]
(send highlight-brush set-stipple b/w-bitmap)
(send dc set-pen highlight-pen)
(send dc set-brush highlight-brush)]
[else (k (void))])
(send dc set-pen highlight-pen)
(send dc set-brush highlight-brush)
(send dc draw-rectangle (+ left dx) (+ top dy) width height)
(send dc set-pen old-pen)
(send dc set-brush old-brush)))))