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

...

Browse Source 
original commit: 637b17ea0240440a782ab9df2b375145a708638b
This commit is contained in:
Robby Findler 2000-12-07 16:24:20 +00:00
parent 59f5d5d052
commit 8a36ccdc18
3 changed files with 33 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/framework/frameworks.ss
View File

@ -175,6 +175,9 @@
searchable<%>
searchable-mixin
searchable-text<%>
searchable-text-mixin
info<%>
info-mixin

31
collects/framework/gen-standard-menus.ss
View File

@ -130,10 +130,23 @@ string=? ; exec mred -qr $0
(define (build-generic-clause x) '(sequence (void)))
(define (build-fill-in-generic-clause generic)
`(public [,(generic-name generic)
,(generic-initializer generic)]))
`(public
[,(generic-name generic)
,(generic-initializer generic)]))
(call-with-output-file (build-path (collection-path "framework") "standard-menus.ss")
(define (build-generic-override-clause x)
`(rename [,(string->symbol (format "super-~a" (generic-override-name x)))
,(generic-override-name x)]))
(define (build-fill-in-generic-override-clause generic)
`(override
[,(generic-override-name generic)
,(generic-override-initializer generic)]))
(define standard-menus.ss-filename (build-path (collection-path "framework") "standard-menus.ss"))
(printf "writing to ~a~n" standard-menus.ss-filename)
(call-with-output-file standard-menus.ss-filename
(lambda (port)
(pretty-print
`(define standard-menus<%>
@ -145,6 +158,7 @@ string=? ; exec mred -qr $0
[(between? x) (list (between->name x))]
[(or (after? x) (before? x))
(list (before/after->name x))]
[(generic-override? x) null]
[(generic? x) (list (generic-name x))]))
items))))
port)
@ -155,7 +169,6 @@ string=? ; exec mred -qr $0
`(define standard-menus-mixin
(mixin (basic<%>) (standard-menus<%>) args
(inherit on-menu-char on-traverse-char)
(rename [super-on-close on-close])
(private
[remove-prefs-callback
(preferences:add-callback
@ -172,12 +185,6 @@ string=? ; exec mred -qr $0
(send menu restore-keybinding)
(send menu set-shortcut #f)))])))))])
(override
[on-close
(lambda ()
(remove-prefs-callback)
(super-on-close))])
(inherit get-menu-bar show can-close? get-edit-target-object)
(sequence (apply super-init args))
,@(append
@ -188,6 +195,7 @@ string=? ; exec mred -qr $0
(build-fill-in-before/after-clause x)]
[(an-item? x) (build-fill-in-item-clause x)]
[(generic? x) (build-fill-in-generic-clause x)]
[(generic-override? x) (build-fill-in-generic-override-clause x)]
[else (printf "~a~n" x)]))
items)
(map (lambda (x)
@ -196,7 +204,8 @@ string=? ; exec mred -qr $0
[(an-item? x) (build-item-menu-clause x)]
[(or (after? x) (before? x))
(build-before/after-menu-clause x)]
[(generic? x) (build-generic-clause x)]))
[(generic? x) (build-generic-clause x)]
[(generic-override? x) (build-generic-override-clause x)]))
items)
(list `(sequence (reorder-menus this))))))
port))

12
collects/framework/standard-menus-items.ss
View File

@ -1,4 +1,5 @@
(define-struct generic (name initializer documentation))
(define-struct generic-override (name initializer documentation))
(define-struct before/after (menu name procedure))
(define-struct (before struct:before/after) ())
@ -59,8 +60,15 @@
(and target (is-a? target editor<%>))))))
(define items
(list (make-generic 'get-menu% '(lambda () menu%)
'("The result of this method is used as the class for creating the result of these methods:"
(list (make-generic-override
'on-close '(lambda ()
(remove-prefs-callback)
(super-on-close))
'("@return : void"
"Removes the preferences callbacks for the menu items"))
(make-generic 'get-menu% '(lambda () menu%)
'("The result of this method is used as the class"
"for creating the result of these methods:"
"@ilink frame:standard-menus get-file-menu %"
", "
"@ilink frame:standard-menus get-edit-menu %"