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

.

Browse Source 
original commit: 13877581d14cd179ebdbb951e3ce968e440475f0
This commit is contained in:
Matthew Flatt 2005-01-04 21:51:48 +00:00
parent 7e03063887
commit 4af9f35e9e
1 changed files with 5 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/mred/mred.ss
View File

@ -3996,7 +3996,7 @@
(check-instance '(method window<%> on-subwindow-event) wx:mouse-event% 'mouse-event% #f e) (check-instance '(method window<%> on-subwindow-event) wx:mouse-event% 'mouse-event% #f e)
#f)] #f)]
[on-drop-file (lambda (s) [on-drop-file (lambda (s)
(unless (string? s) (unless (path-string? s)
(raise-type-error (who->name '(method window<%> on-drop-file)) "pathname string" s)))] (raise-type-error (who->name '(method window<%> on-drop-file)) "pathname string" s)))]
[focus (entry-point (lambda () (send wx set-focus)))] [focus (entry-point (lambda () (send wx set-focus)))]
@ -6180,7 +6180,7 @@
(custodian-shutdown-all user-custodian) (custodian-shutdown-all user-custodian)
(semaphore-post waiting))]) (semaphore-post waiting))])
(override (override
[on-drop-file (lambda (f) (evaluate (format "(load ~s)" f)))]) [on-drop-file (lambda (f) (evaluate (format "(load ~s)" (path->string f))))])
(sequence (sequence
(apply super-init args) (accept-drop-files #t))) (apply super-init args) (accept-drop-files #t)))
"MrEd REPL" #f 500 400)) "MrEd REPL" #f 500 400))
@ -6242,7 +6242,9 @@
(let ([mb (make-object menu-bar% frame)]) (let ([mb (make-object menu-bar% frame)])
(let ([m (make-object menu% "&File" mb)]) (let ([m (make-object menu% "&File" mb)])
(make-object menu-item% "Load File..." m (lambda (i e) (let ([f (get-file #f frame)]) (and f (evaluate (format "(load ~s)" f)))))) (make-object menu-item% "Load File..." m (lambda (i e) (let ([f (get-file #f frame)])
(and f
(evaluate (format "(load ~s)" (path->string f)))))))
(unless (current-eventspace-has-standard-menus?) (unless (current-eventspace-has-standard-menus?)
(make-object menu-item% (make-object menu-item%
(if (eq? (system-type) 'windows) (if (eq? (system-type) 'windows)