pull the keybindings code out of the framework compound unit structure

This commit is contained in:
Robby Findler 2015-03-14 12:54:33 -05:00
parent 9cc25592c3
commit ce926b4692
7 changed files with 1542 additions and 1470 deletions

View File

@ -5,6 +5,7 @@
"sig.rkt"
"../preferences.rkt"
"../gui-utils.rkt"
"interfaces.rkt"
mzlib/etc
mred/mred-sig
racket/path)
@ -26,22 +27,7 @@
;; renaming, for editor-mixin where get-file is shadowed by a method.
(define mred:get-file get-file)
(define basic<%>
(interface (editor<%>)
has-focus?
local-edit-sequence?
run-after-edit-sequence
get-top-level-window
save-file-out-of-date?
save-file/gui-error
load-file/gui-error
on-close
can-close?
close
get-filename/untitled-name
get-pos/text
get-pos/text-dc-location))
(define basic<%> editor:basic<%>)
(define basic-mixin
(mixin (editor<%>) (basic<%>)
@ -506,7 +492,7 @@
delta)))
(void)))
(define -keymap<%> (interface (basic<%>) get-keymaps))
(define -keymap<%> editor:keymap<%>)
(define keymap-mixin
(mixin (basic<%>) (-keymap<%>)
(define/public (get-keymaps)

View File

@ -10,6 +10,7 @@
"../gui-utils.rkt"
"bday.rkt"
"gen-standard-menus.rkt"
"interfaces.rkt"
framework/private/focus-table
mrlib/close-icon
mred/mred-sig)
@ -132,15 +133,7 @@
(set! frame-width (min frame-width (- w window-trimming-upper-bound-width)))
(set! frame-height (min frame-height (- h window-trimming-upper-bound-height)))))
(define basic<%> (interface ((class->interface frame%))
get-area-container%
get-area-container
get-menu-bar%
make-root-area-container
close
editing-this-file?
get-filename
make-visible))
(define basic<%> frame:basic<%>)
(define focus-table<%> (interface (top-level-window<%>)))
(define focus-table-mixin
@ -741,17 +734,7 @@
(super-new)))
(define info<%> (interface (basic<%>)
determine-width
lock-status-changed
update-info
set-info-canvas
get-info-canvas
get-info-editor
get-info-panel
show-info
hide-info
is-info-hidden?))
(define info<%> frame:info<%>)
(define magic-space 25)
@ -1038,13 +1021,7 @@
(min-client-height (inexact->exact (floor th)))))
(update-client-width init-width)))
(define text-info<%> (interface (info<%>)
set-macro-recording
overwrite-status-changed
anchor-status-changed
editor-position-changed
use-file-text-mode-changed
add-line-number-menu-items))
(define text-info<%> frame:text-info<%>)
(define text-info-mixin
(mixin (info<%>) (text-info<%>)
(inherit get-info-editor)
@ -1343,6 +1320,7 @@
(mixin (basic<%>) (pasteboard-info<%>)
(super-new)))
(define standard-menus<%> frame:standard-menus<%>)
(generate-standard-menus-code)
(define -editor<%> (interface (standard-menus<%>)

View File

@ -101,29 +101,34 @@
`((define/public ,(generic-name generic)
,(generic-initializer generic)))]))
(provide generate-standard-menus-code)
(provide generate-standard-menus-code
generate-standard-menus-interface-code)
(define-syntax (generate-standard-menus-interface-code stx)
(datum->syntax
stx
`(define frame:standard-menus<%>
(interface (frame:basic<%>)
,@(append-map
(λ (x)
(cond [(an-item? x)
(list (an-item->callback-name x)
(an-item->get-item-name x)
(an-item->string-name x)
(an-item->help-string-name x)
(an-item->on-demand-name x)
(an-item->create-menu-item-name x))]
[(between? x)
(list (between->name x))]
[(or (after? x) (before? x))
(list (before/after->name x))]
[(generic? x)
(if (generic-method? x) (list (generic-name x)) '())]))
items)))))
(define-syntax (generate-standard-menus-code stx)
(datum->syntax
stx
`(begin
(define standard-menus<%>
(interface (basic<%>)
,@(append-map
(λ (x)
(cond [(an-item? x)
(list (an-item->callback-name x)
(an-item->get-item-name x)
(an-item->string-name x)
(an-item->help-string-name x)
(an-item->on-demand-name x)
(an-item->create-menu-item-name x))]
[(between? x)
(list (between->name x))]
[(or (after? x) (before? x))
(list (before/after->name x))]
[(generic? x)
(if (generic-method? x) (list (generic-name x)) '())]))
items)))
(define standard-menus-mixin
(mixin (basic<%>) (standard-menus<%>)
(inherit on-menu-char on-traverse-char)

View File

@ -0,0 +1,86 @@
#lang racket/base
(require racket/class
racket/gui/base
"gen-standard-menus.rkt")
(provide editor:basic<%>
editor:keymap<%>
text:basic<%>
frame:basic<%>
frame:standard-menus<%>
frame:info<%>
frame:text-info<%>)
(define editor:basic<%>
(interface (editor<%>)
has-focus?
local-edit-sequence?
run-after-edit-sequence
get-top-level-window
save-file-out-of-date?
save-file/gui-error
load-file/gui-error
on-close
can-close?
close
get-filename/untitled-name
get-pos/text
get-pos/text-dc-location))
(define editor:keymap<%>
(interface (editor:basic<%>)
get-keymaps))
(define text:basic<%>
(interface (editor:basic<%> (class->interface text%))
highlight-range
unhighlight-range
unhighlight-ranges
unhighlight-ranges/key
get-highlighted-ranges
get-styles-fixed
get-fixed-style
set-styles-fixed
move/copy-to-edit
initial-autowrap-bitmap
get-port-name
port-name-matches?
after-set-port-unsaved-name
set-port-unsaved-name
get-start-of-line))
(define frame:basic<%>
(interface ((class->interface frame%))
get-area-container%
get-area-container
get-menu-bar%
make-root-area-container
close
editing-this-file?
get-filename
make-visible))
(generate-standard-menus-interface-code)
(define frame:info<%>
(interface (frame:basic<%>)
determine-width
lock-status-changed
update-info
set-info-canvas
get-info-canvas
get-info-editor
get-info-panel
show-info
hide-info
is-info-hidden?))
(define frame:text-info<%>
(interface (frame:info<%>)
set-macro-recording
overwrite-status-changed
anchor-status-changed
editor-position-changed
use-file-text-mode-changed
add-line-number-menu-items))

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -6,6 +6,7 @@
racket/path
racket/math
"sig.rkt"
"interfaces.rkt"
"../gui-utils.rkt"
"../preferences.rkt"
"autocomplete.rkt"
@ -85,23 +86,7 @@
(values register-port-name! lookup-port-name)))
(define basic<%>
(interface (editor:basic<%> (class->interface text%))
highlight-range
unhighlight-range
unhighlight-ranges
unhighlight-ranges/key
get-highlighted-ranges
get-styles-fixed
get-fixed-style
set-styles-fixed
move/copy-to-edit
initial-autowrap-bitmap
get-port-name
port-name-matches?
after-set-port-unsaved-name
set-port-unsaved-name
get-start-of-line))
(define basic<%> text:basic<%>)
(define highlight-range-mixin
(mixin (editor:basic<%> (class->interface text%)) ()