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

52
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,29 +4413,33 @@
[(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
(check-instance 'append-editor-operation-menu-items menu% 'menu% #f m) (case-lambda
(let ([mk (lambda (name key op) [(m) (append-editor-operation-menu-items m #t)]
(make-object menu-item% name m [(m text-only?)
(lambda (i e) (check-instance 'append-editor-operation-menu-items menu% 'menu% #f m)
(let* ([f (find-item-frame i)] (let ([mk (lambda (name key op)
[o (and f (send f get-edit-target-object))]) (make-object menu-item% name m
(and o (is-a? o wx:editor<%>) (lambda (i e)
(send o do-edit-operation op)))) (let* ([f (find-item-frame i)]
key))] [o (and f (send f get-edit-target-object))])
[mk-sep (lambda () (make-object separator-menu-item% m))]) (and o (is-a? o wx:editor<%>)
(mk "Undo" #\z 'undo) (send o do-edit-operation op))))
(mk "Redo" #f 'redo) key))]
(mk-sep) [mk-sep (lambda () (make-object separator-menu-item% m))])
(mk "Clear" #f 'clear) (mk "Undo" #\z 'undo)
(mk "Copy" #\c 'copy) (mk "Redo" #f 'redo)
(mk "Cut" #\x 'cut) (mk-sep)
(mk "Paste" #\v 'paste) (mk "Clear" #f 'clear)
(mk-sep) (mk "Copy" #\c 'copy)
(mk "Insert Text Box" #f 'insert-text-box) (mk "Cut" #\x 'cut)
(mk "Insert Pasteboard Box" #f 'insert-pasteboard-box) (mk "Paste" #\v 'paste)
(mk "Insert Image..." #f 'insert-image) (unless text-only?
(void))) (mk-sep)
(mk "Insert Text Box" #f 'insert-text-box)
(mk "Insert Pasteboard Box" #f 'insert-pasteboard-box)
(mk "Insert Image..." #f 'insert-image))
(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)