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

...

Browse Source 
original commit: eaae13210567623d4b65f7c18ebb2ea2e9cbf1e9
This commit is contained in:
Robby Findler 2001-10-07 04:06:37 +00:00
parent be15bfed67
commit 6c176ec1cd
2 changed files with 19 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/framework/private/gen-standard-menus.ss
View File

@ -18,7 +18,7 @@
`[define ,(an-item->get-item-name item)
(lambda () ,(an-item->item-name item))]
`[define ,(an-item->string-name item)
(lambda () "")]
(lambda () ,(an-item-menu-string item))]
`[define ,(an-item->help-string-name item)
(lambda () ,(an-item-help-string item))]
`[define ,(an-item->on-demand-name item)
@ -53,22 +53,12 @@
(let* ([callback-name (an-item->callback-name item)]
[create-menu-item-name (an-item->create-menu-item-name item)]
[callback-name-string (symbol->string callback-name)]
[menu-before-string (an-item-menu-string-before item)]
[menu-after-string (an-item-menu-string-after item)]
[key (an-item-key item)]
[join (lambda (base-text suffix-text special-text)
`(let ([special ,special-text]
[base ,base-text]
[suffix ,suffix-text])
(if (string=? special "")
(string-append base suffix)
(string-append base " " special suffix))))])
[key (an-item-key item)])
(list `(define
,(an-item->item-name item)
(and (,create-menu-item-name)
(instantiate (get-menu-item%) ()
(label ,(join menu-before-string menu-after-string
`(,(an-item->string-name item))))
(label (,(an-item->string-name item)))
(parent ,(menu-item-menu-name item))
(callback (let ([,callback-name (lambda (item evt) (,callback-name item evt))])
,callback-name))

54
collects/framework/private/standard-menus-items.ss
View File

@ -18,7 +18,7 @@
(struct between (before after procedure))
(struct an-item (item-name help-string proc key menu-string-before menu-string-after on-demand))
(struct an-item (item-name help-string proc key menu-string on-demand))
;; an-item -> symbol
;; calcualates the names of various identifiers associated with the item.
@ -69,8 +69,7 @@
help-string
proc
key
menu-string-before
menu-string-after
menu-string
on-demand))
(define (an-item->callback-name item)
@ -212,50 +211,43 @@
'(string-constant new-info)
'(lambda (item control) (handler:edit-file #f) #t)
#\n
'(string-constant new-menu-item-before)
'(string-constant new-menu-item-after)
'(string-constant new-menu-item)
on-demand-do-nothing)
(make-between 'file-menu 'new 'open 'nothing)
(make-an-item 'file-menu 'open '(string-constant open-info)
'(lambda (item control) (handler:open-file) #t)
#\o
'(string-constant open-menu-item-before)
'(string-constant open-menu-item-after)
'(string-constant open-menu-item)
on-demand-do-nothing)
(make-between 'file-menu 'open 'revert 'nothing)
(make-an-item 'file-menu 'revert
'(string-constant revert-info)
#f #f
'(string-constant revert-menu-item-before)
'(string-constant revert-menu-item-after)
'(string-constant revert-menu-item)
on-demand-do-nothing)
(make-between 'file-menu 'revert 'save 'nothing)
(make-an-item 'file-menu 'save
'(string-constant save-info)
#f #\s
'(string-constant save-menu-item-before)
'(string-constant save-menu-item-after)
'(string-constant save-menu-item)
on-demand-do-nothing)
(make-an-item 'file-menu 'save-as
'(string-constant save-as-info)
#f #f
'(string-constant save-as-menu-item-before)
'(string-constant save-as-menu-item-after)
'(string-constant save-as-menu-item)
on-demand-do-nothing)
(make-between 'file-menu 'save-as 'print 'separator)
(make-an-item 'file-menu 'print
'(string-constant print-info)
#f #\p
'(string-constant print-menu-item-before)
'(string-constant print-menu-item-after)
'(string-constant print-menu-item)
on-demand-do-nothing)
(make-between 'file-menu 'print 'close 'separator)
(make-an-item 'file-menu 'close
'(string-constant close-info)
'(lambda (item control) (when (can-close?) (on-close) (show #f)) #t)
#\w
'(string-constant close-menu-item-before)
'(string-constant close-menu-item-after)
'(string-constant close-menu-item)
on-demand-do-nothing)
(make-between 'file-menu 'close 'quit 'nothing)
(make-an-item 'file-menu 'quit
@ -265,9 +257,8 @@
(exit:exit)))
#\q
'(if (eq? (system-type) 'windows)
(string-constant quit-menu-item-before-windows)
(string-constant quit-menu-item-before-others))
'(string-constant quit-menu-item-after)
(string-constant quit-menu-item-windows)
(string-constant quit-menu-item-others))
on-demand-do-nothing)
(make-after 'file-menu 'quit 'nothing)
@ -276,21 +267,18 @@
(edit-menu:do 'undo)
#\z
'(string-constant undo-menu-item)
""
(edit-menu:can-do-on-demand 'undo))
(make-an-item 'edit-menu 'redo
'(string-constant redo-info)
(edit-menu:do 'redo)
#\y
'(string-constant redo-menu-item)
""
(edit-menu:can-do-on-demand 'redo))
(make-between 'edit-menu 'redo 'cut 'separator)
(make-an-item 'edit-menu 'cut '(string-constant cut-info)
(edit-menu:do 'cut)
#\x
'(string-constant cut-menu-item)
""
(edit-menu:can-do-on-demand 'cut))
(make-between 'edit-menu 'cut 'copy 'nothing)
(make-an-item 'edit-menu 'copy
@ -298,7 +286,6 @@
(edit-menu:do 'copy)
#\c
'(string-constant copy-menu-item)
""
(edit-menu:can-do-on-demand 'copy))
(make-between 'edit-menu 'copy 'paste 'nothing)
(make-an-item 'edit-menu 'paste
@ -306,7 +293,6 @@
(edit-menu:do 'paste)
#\v
'(string-constant paste-menu-item)
""
(edit-menu:can-do-on-demand 'paste))
(make-between 'edit-menu 'paste 'clear 'nothing)
(make-an-item 'edit-menu 'clear
@ -316,7 +302,6 @@
'(if (eq? (system-type) 'windows)
(string-constant clear-menu-item-windows)
(string-constant clear-menu-item-windows))
""
(edit-menu:can-do-on-demand 'clear))
(make-between 'edit-menu 'clear 'select-all 'nothing)
(make-an-item 'edit-menu 'select-all
@ -324,7 +309,6 @@
(edit-menu:do 'select-all)
#\a
'(string-constant select-all-menu-item)
""
(edit-menu:can-do-on-demand 'select-all))
(make-between 'edit-menu 'select-all 'find 'separator)
@ -332,29 +316,25 @@
'(string-constant find-info)
#f
#\f
'(string-constant find-menu-item-before)
'(string-constant find-menu-item-after)
'(string-constant find-menu-item)
edit-menu:edit-target-on-demand)
(make-an-item 'edit-menu 'find-again
'(string-constant find-again-info)
#f
#\g
'(string-constant find-again-menu-item-before)
'(string-constant find-again-menu-item-after)
'(string-constant find-again-menu-item)
edit-menu:edit-target-on-demand)
(make-an-item 'edit-menu 'replace-and-find-again
'(string-constant replace-and-find-again-info)
#f #\h
'(string-constant replace-and-find-again-menu-item-before)
'(string-constant replace-and-find-again-menu-item-after)
'(string-constant replace-and-find-again-menu-item)
edit-menu:edit-target-on-demand)
(make-between 'edit-menu 'find 'preferences 'separator)
(make-an-item 'edit-menu 'preferences
'(string-constant preferences-info)
'(lambda (item control) (preferences:show-dialog) #t)
#\;
'(string-constant preferences-menu-item-before)
'(string-constant preferences-menu-item-after)
'(string-constant preferences-menu-item)
on-demand-do-nothing)
(make-after 'edit-menu 'preferences 'nothing)
@ -363,8 +343,6 @@
'(string-constant about-info)
#f
#f
'(string-constant about-menu-item-before)
'(string-constant about-menu-item-after)
'(string-constant about-menu-item)
on-demand-do-nothing)
(make-after 'help-menu 'about 'nothing))))