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

.

Browse Source 
original commit: 67ef93d7d5e95ad3c9d9901e45a9d44d9b23d6b8
This commit is contained in:
Matthew Flatt 1998-11-26 00:12:35 +00:00
parent ca8ad52774
commit b067200d0a
1 changed files with 28 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
src/mred/wrap/mred.ss
View File

@ -3895,7 +3895,7 @@
(make-object menu-item% "Load File..." m (lambda (i e) (let ([f (get-file)]) (and f (evaluate (format "(load ~s)" f)))))) (make-object menu-item% "Load File..." m (lambda (i e) (let ([f (get-file)]) (and f (evaluate (format "(load ~s)" f))))))
(make-object menu-item% "Quit" m (lambda (i e) (send frame on-close) (send frame show #f)) #\q)) (make-object menu-item% "Quit" m (lambda (i e) (send frame on-close) (send frame show #f)) #\q))
(let ([m (make-object menu% "Edit" mb)]) (let ([m (make-object menu% "Edit" mb)])
(append-editor-operation-menu-items m))) (append-editor-operation-menu-items m #f)))
;; Just a few extra key bindings: ;; Just a few extra key bindings:
(install-standard-text-bindings repl-buffer) (install-standard-text-bindings repl-buffer)
@ -4413,7 +4413,10 @@
[(is-a? p menu%) (loop (send p get-item))] [(is-a? p menu%) (loop (send p get-item))]
[else (send p get-frame)])))) [else (send p get-frame)]))))
(define (append-editor-operation-menu-items m) (define append-editor-operation-menu-items
(case-lambda
[(m) (append-editor-operation-menu-items m #t)]
[(m text-only?)
(check-instance 'append-editor-operation-menu-items menu% 'menu% #f m) (check-instance 'append-editor-operation-menu-items menu% 'menu% #f m)
(let ([mk (lambda (name key op) (let ([mk (lambda (name key op)
(make-object menu-item% name m (make-object menu-item% name m
@ -4431,11 +4434,12 @@
(mk "Copy" #\c 'copy) (mk "Copy" #\c 'copy)
(mk "Cut" #\x 'cut) (mk "Cut" #\x 'cut)
(mk "Paste" #\v 'paste) (mk "Paste" #\v 'paste)
(unless text-only?
(mk-sep) (mk-sep)
(mk "Insert Text Box" #f 'insert-text-box) (mk "Insert Text Box" #f 'insert-text-box)
(mk "Insert Pasteboard Box" #f 'insert-pasteboard-box) (mk "Insert Pasteboard Box" #f 'insert-pasteboard-box)
(mk "Insert Image..." #f 'insert-image) (mk "Insert Image..." #f 'insert-image))
(void))) (void))]))
(define (append-editor-font-menu-items m) (define (append-editor-font-menu-items m)
(check-instance 'append-editor-font-menu-items menu% 'menu% #f m) (check-instance 'append-editor-font-menu-items menu% 'menu% #f m)