38 lines
1.5 KiB
Scheme
38 lines
1.5 KiB
Scheme
;; This code is duplicated from the servelt-builder.ss file
|
|
(module find-scheme-menu mzscheme
|
|
|
|
(provide find-scheme-menu)
|
|
|
|
(require
|
|
(lib "class.ss")
|
|
(lib "mred.ss" "mred")
|
|
(lib "string-constant.ss" "string-constants"))
|
|
|
|
; : menu% -> (U menu% #f)
|
|
; to crawl up and down the menu hierarcy to find the scheme menu
|
|
; This attempts to work even if
|
|
; a) the menus and menu items are in a different langauge
|
|
; b) the menus are in Philippe's language where they are all blank (and hence the same)
|
|
; It starts by selecting the menu by position to avoid problem b).
|
|
; Just to be paranoid, it looks in other positions, too.
|
|
; The scheme menu must have "Create Executable..." in some language as a menu item.
|
|
(define (find-scheme-menu special-menu)
|
|
(let* ([bar (send special-menu get-parent)]
|
|
[menus (send bar get-items)]
|
|
[ordered-menus (if (< (length menus) 5)
|
|
menus
|
|
(cons (car (cddddr menus)) menus))])
|
|
(ormap (lambda (m)
|
|
(and (string=? (label->plain-label (string-constant scheme-menu-name))
|
|
(send m get-plain-label))
|
|
(ormap is-create-executable-item? (send m get-items))
|
|
m))
|
|
ordered-menus)))
|
|
|
|
|
|
; menu-item% -> bool
|
|
(define (is-create-executable-item? item)
|
|
(and (is-a? item labelled-menu-item<%>)
|
|
(string=? (string-constant create-executable-menu-item-label)
|
|
(send item get-label))))
|
|
) |