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

...

Browse Source 
original commit: 174863d28b9cd14141603df73aee0334ffd7c2b0
This commit is contained in:
John Clements 2001-10-30 05:46:44 +00:00
parent c245f386ae
commit 0a4f39121e
1 changed files with 10 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
collects/mred/mred.ss
View File

@ -2568,7 +2568,8 @@
(define wx-grow-box-pane%
(class100 (wx-make-pane% wx:windowless-panel% #f) (mred proxy parent style)
(override
[init-min (lambda (x) (if (eq? (system-type) 'macos)
[init-min (lambda (x) (if (or (eq? (system-type) 'macos)
(eq? (system-type) 'macosx))
15
0))])
(sequence
@ -4403,8 +4404,8 @@
#t))]
[(windows) (format "~aCtl+~a" #\tab
(char-name (char-upcase shortcut) #t))]
[(macos) (format "~aCmd+~a" #\tab
(char-name (char-upcase shortcut) #t))]))
[(macos macosx) (format "~aCmd+~a" #\tab
(char-name (char-upcase shortcut) #t))]))
(strip-tab label))]
[key-binding (and shortcut
(case (system-type)
@ -4416,7 +4417,7 @@
[(ctl) ":c:"])
(char-name (char-downcase shortcut) #f))]
[(windows) (format ":c:~a" (char-name (char-downcase shortcut) #f))]
[(macos) (format ":d:~a" (char-name (char-downcase shortcut) #f))]))]
[(macos macosx) (format ":d:~a" (char-name (char-downcase shortcut) #f))]))]
[keymap (and key-binding
(let ([keymap (make-object wx:keymap%)])
(send keymap add-function "menu-item"
@ -4638,7 +4639,7 @@
(append
(case (system-type)
[(windows) '(":c:c" ":c:x" ":c:v" ":c:k" ":c:z" ":c:a")]
[(macos) '(":d:c" ":d:x" ":d:v" ":d:k" ":d:z" ":d:a")]
[(macos macosx) '(":d:c" ":d:x" ":d:v" ":d:k" ":d:z" ":d:a")]
[(unix) '(":m:w" ":c:w" ":c:y" ":c:k" ":c:s:_" ":m:a")])
'(":middlebutton"))
'("copy-clipboard" "cut-clipboard" "paste-clipboard" "delete-to-end-of-line"
@ -5447,20 +5448,15 @@
"play ~s"]
[(regexp-match (make-pattern "solaris") subpath)
"audioplay ~s"]
[(regexp-match (make-pattern "ppc-macosx") subpath)
'use-play-sound]
[else
(raise-mismatch-error
'play-sound
"not supported by default on this platform"
subpath)]))])
(if (eq? (unbox b) 'use-play-sound)
(wx:play-sound f async?)
(begin
; see if user has overridden defaults
(wx:get-resource "mred" "playcmd" b)
((if async? (lambda (x) (process x) #t) system)
(format (unbox b) (expand-path f)))))))))
; see if user has overridden defaults
(wx:get-resource "mred" "playcmd" b)
((if async? (lambda (x) (process x) #t) system)
(format (unbox b) (expand-path f)))))))
(define (get-display-size)
(let ([xb (box 0)]