1  #lang racket/base
 2  
 3  (require (for-syntax racket/base)
 4           racket/unit
 5           racket/class
 6           racket/surrogate
 7           "sig.rkt")
 8  
 9  (provide mode@ surrogate-methods)
10  
11  (define-syntax (surrogate-methods stx)
12    (syntax-case stx ()
13      [(_ m)
14       #'(m (augment (void) on-change ())
15            (override on-char (event))
16            (override on-default-char (event))
17            (override on-default-event (event))
18            (augment (void) on-display-size ())
19            (augment (void) on-edit-sequence ())
20            (override on-event (event))
21            (override on-focus (on?))
22            (augment (void) on-load-file (filename format))
23            (override on-local-char (event))
24            (override on-local-event (event))
25            (override on-new-box (type))
26            (override on-new-image-snip (filename kind relative-path? inline?))
27            (override on-paint (before? dc left top right bottom dx dy draw-caret))
28            (augment (void) on-save-file (filename format))
29            (augment (void) on-snip-modified (snip modified?))
30            
31            (augment (void) on-change-style (start len))
32            (augment (void) on-delete (start len))
33            (augment (void) on-insert (start len))
34            (override on-new-string-snip ())
35            (override on-new-tab-snip ())
36            (augment (void) on-set-size-constraint ())
37            
38            (augment (void) after-change-style (start len))
39            (augment (void) after-delete (start len))
40            (augment (void) after-insert (start len))
41            (augment (void) after-set-position ())
42            (augment (void) after-set-size-constraint ())
43            (augment (void) after-edit-sequence ())
44            (augment (void) after-load-file (success?))
45            (augment (void) after-save-file (success?))
46            
47            (augment #t can-change-style? (start len))
48            (augment #t can-delete? (start len))
49            (augment #t can-insert? (start len))
50            (augment #t can-set-size-constraint? ())
51            (override can-do-edit-operation? (op) (op recursive?))
52            (augment #t can-load-file? (filename format))
53            (augment #t can-save-file? (filename format))
54            
55            (override put-file (directory default-name)))]))
56  
57  (define-unit mode@
58    (import)
59    (export framework:mode^)
60    
61    (define-values (host-text-mixin host-text<%> surrogate-text% surrogate-text<%>)
62      (surrogate-methods surrogate)))