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

updating for 299

Browse Source 
original commit: d4ceb4deb8b575a02cc0f64ed60f2cd31026f236
This commit is contained in:
Mike MacHenry 2004-09-27 21:28:51 +00:00
parent 7750506245
commit a893ad43ea
12 changed files with 44 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/embedded-gui/private/aligned-pasteboard.ss
View File

@ -70,18 +70,16 @@
#;((is-a?/c snip%) . -> . void?)
;; Called when a snip in the pasteboard changes its size
;; Overriden because the layout will change when a snip gets bigger.
(rename [super-really-resized really-resized])
(define/override (really-resized snip)
(super-really-resized snip)
(super really-resized snip)
(realign))
#;(-> void)
;; Called when the pasteboard is first shown.
;; Overriden because I need to know when the snips have their size to lay them out.
(rename [super-on-show on-show])
(define/override (on-show)
(realign)
(super-on-show))
(super on-show))
#;(boolean? . -> . void?)
;; Locks the pasteboard so that all alignment requests are delayed until after it's done.

2
collects/embedded-gui/private/button-snip.ss
View File

@ -63,7 +63,6 @@
(load-file image))
;; Should I be calling super-on-event?
(rename [super-on-event on-event])
(define/override (on-event dc x y editorx editory event)
(case (send event get-event-type)
[(left-down)
@ -98,7 +97,6 @@
[got-click? false]
[inside? false])
(rename [super-on-event on-event])
(define/override (on-event dc x y editorx editory event)
(case (send event get-event-type)
[(left-down)

6
collects/embedded-gui/private/fixed-width-label-snip.ss
View File

@ -61,9 +61,8 @@
(when w (set-box! w (+ left-margin width right-margin)))
(when h (set-box! h (+ top-margin height bottom-margin)))))
(rename [super-draw draw])
(define/override (draw dc x y left top right bottom dx dy draw-caret)
(super-draw dc x y left top right bottom dx dy draw-caret)
(super draw dc x y left top right bottom dx dy draw-caret)
(let ([max-width (get-max-string-width dc labels)]
[width (get-string-width dc label)]
[max-height (get-max-string-height dc labels)])
@ -85,9 +84,8 @@
x
y)))))
;(rename [super-copy copy])
;(define/override (copy)
; (super-copy))
; (super copy))
(define/override (resize w h) #f)

6
collects/embedded-gui/private/grey-editor.ss
View File

@ -11,7 +11,6 @@
(define grey-editor-snip-mixin
(mixin ((class->interface editor-snip%)) ()
(rename [super-draw draw])
(inherit get-admin get-inset)
(define/override (draw dc x y left top right bottom dx dy draw-caret)
(let ([old-pen (send dc get-pen)]
@ -37,12 +36,11 @@
(max 0 (- (unbox hb) (+ (unbox top-inset) (unbox bottom-inset)))))
(send dc set-pen old-pen)
(send dc set-brush old-brush)))
(super-draw dc x y left top right bottom dx dy draw-caret))
(super draw dc x y left top right bottom dx dy draw-caret))
(super-new)))
(define grey-editor-mixin
(mixin (editor<%>) ()
(rename [super-on-paint on-paint])
(define/override (on-paint before? dc left top right bottom dx dy draw-caret)
(when before?
(let ([old-pen (send dc get-pen)]
@ -52,5 +50,5 @@
(send dc draw-rectangle (+ left dx) (+ top dy) (+ right dx) (+ bottom dy))
(send dc set-pen old-pen)
(send dc set-brush old-brush)))
(super-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))
(super-new))))

6
collects/embedded-gui/private/grid-alignment.ss
View File

@ -1,4 +1,10 @@
#| Not yet functional |#
(module grid-alignment mzscheme
(define grid-alignment #f)
(provide grid-alignment))
#;(module grid-alignment mzscheme
(require
(lib "class.ss")

6
collects/embedded-gui/private/on-show-pasteboard.ss
View File

@ -13,17 +13,15 @@
(class super%
(field [shown? false])
#|
(rename [super-refresh refresh])
(define/override (refresh x y w h d-c)
(super-refresh x y (max w 0) (max h 0) d-c)
(super refresh x y (max w 0) (max h 0) d-c)
(unless shown?
(set! shown? true)
(on-show)))
|#
#|
(rename [super-get-extent get-extent])
(define/override (get-extent w h)
(super-get-extent w h)
(super get-extent w h)
(unless shown?
(set! shown? true)
(on-show)))

9
collects/embedded-gui/private/program-editor.ss
View File

@ -34,8 +34,6 @@ is being reset.
(define (program-editor-mixin %)
(class %
(inherit get-admin begin-edit-sequence end-edit-sequence)
(rename [super-after-insert after-insert]
[super-after-delete after-delete])
(define (get-frame)
;; gets the top most editor in the tree of snips and editors
(define (editor-root ed)
@ -69,21 +67,20 @@ is being reset.
(send* (send frame get-definitions-text)
(set-modified true)))))
;(rename [super-on-insert on-insert])
;(define/override (on-insert start len)
; (begin-edit-sequence)
; (super-on-insert start len)
; (super on-insert start len)
; (end-edit-sequence))
(define/override (after-insert start len)
(alert-of-modify)
;(begin-edit-sequence)
(super-after-insert start len)
(super after-insert start len)
;(end-edit-sequence)
)
(define/override (after-delete start len)
(alert-of-modify)
(super-after-delete start len))
(super after-delete start len))
(super-new)))
(define program-editor%

17
collects/embedded-gui/private/really-resized-pasteboard.ss
View File

@ -35,9 +35,8 @@ get text deteleted from them, etc.
snip : snip% object
redraw-now? : boolean
|#
(rename [super-resized resized])
(define/override (resized snip redraw-now?)
(super-resized snip redraw-now?)
(super resized snip redraw-now?)
(unless ignore-resizing?
(let ([size (snip-size snip)])
;; The snip is getting remove from hash table in a way I
@ -54,18 +53,16 @@ get text deteleted from them, etc.
x : real number
y : real number
|#
(rename [super-after-insert after-insert])
(define/override (after-insert snip before x y)
(super-after-insert snip before x y)
(hash-table-put! snip-cache snip (snip-size snip)))
(define/augment (after-insert snip before x y)
(hash-table-put! snip-cache snip (snip-size snip))
(inner (void) snip before x y))
#|
snip : snip% object
|#
(rename [super-after-delete after-delete])
(define/override (after-delete snip)
(super-after-delete snip)
(hash-table-remove! snip-cache snip))
(define/augment (after-delete snip)
(hash-table-remove! snip-cache snip)
(inner (void) snip))
#;((is-a?/c snip%) . -> . (cons/p natural-number? natural-number?))
;; The width and height of the given snip in this pasteboard.

3
collects/embedded-gui/private/single-line-text.ss
View File

@ -11,12 +11,11 @@
(mixin (editor:keymap<%>) ()
#;(-> (listof keymap%))
;; the list of keymaps associated with this text
(rename [super-get-keymaps get-keymaps])
(define/override (get-keymaps)
(let ([keymap (make-object keymap%)])
(send keymap add-function "do nothing" void)
(send keymap map-function ":enter" "do nothing")
(cons keymap (super-get-keymaps))))
(cons keymap (super get-keymaps))))
(super-new)))
#|

13
collects/embedded-gui/private/stretchable-editor-snip.ss
View File

@ -53,9 +53,8 @@
(define/public (stretch w h)
(super-resize w h))
(rename [super-get-extent get-extent])
(define/override (get-extent dc x y w h descent space lspace rspace)
(super-get-extent dc x y w h descent space lspace rspace)
(super get-extent dc x y w h descent space lspace rspace)
(when (is-a? (get-editor) text%)
(set-box! w (sub1 (unbox w))))
(go))
@ -70,8 +69,6 @@
;; NOTE: Can I make this not public? I don't think it
;; should be but it's been a while since I wrote this class.
(rename [super-set-min-width set-min-width]
[super-set-min-height set-min-height])
(define/public (super-resize w h)
(let ((top (box 0))
(bot (box 0))
@ -87,11 +84,11 @@
;; sure if this change here is sound and works for every part of this
;; class.
(if (> w aligned-min-width)
(super-set-min-width w)
(super-set-min-width 'none))
(super set-min-width w)
(super set-min-width 'none))
(if (> h aligned-min-height)
(super-set-min-height h)
(super-set-min-height 'none))
(super set-min-height h)
(super set-min-height 'none))
(when a (send a resized this #t)))))
;; call this from within get extent and use the values it produces by subtracting the

12
collects/embedded-gui/private/suppress-modify-editor.ss
View File

@ -12,21 +12,17 @@
(define (suppress-modify-editor-mixin %)
(class %
(inherit set-modified)
(rename [super-after-delete after-delete]
[super-after-insert after-insert]
[super-after-move-to after-move-to]
[super-after-resize after-resize])
#;(define/override (after-delete snip)
(super-after-delete snip)
(super after-delete snip)
(set-modified false))
#;(define/override (after-insert snip before x y)
(super-after-insert snip before x y)
(super after-insert snip before x y)
(set-modified false))
#;(define/override (after-move-to snip x y dragging?)
(super-after-move-to snip x y dragging?)
(super after-move-to snip x y dragging?)
(set-modified false))
#;(define/override (after-resize snip w h resized?)
(super-after-resize snip w h resized?)
(super after-resize snip w h resized?)
(set-modified false))
(super-new)))
)

3
collects/embedded-gui/private/tabbable-text.ss
View File

@ -24,7 +24,6 @@
;; get-keymaps (-> (listof keymap%))
;; the list of keymaps associated with this text
(rename [super-get-keymaps get-keymaps])
(define/override (get-keymaps)
(let ([keymap (make-object keymap%)])
(send keymap add-function "tab-ahead"
@ -35,7 +34,7 @@
(lambda (ignored event)
(back)))
(send keymap map-function "s:tab" "tab-back")
(cons keymap (super-get-keymaps))))
(cons keymap (super get-keymaps))))
(define/public (set-ahead t) (set! ahead t))
(define/public (set-back t) (set! back t))