interfaces.rkt (4480B)
1 #lang racket/base 2 (require racket/class/iop 3 (for-syntax racket/base)) 4 (provide (all-defined-out)) 5 6 ;; Helpers 7 8 (define-for-syntax (join . args) 9 (define (->string x) 10 (cond [(string? x) x] 11 [(symbol? x) (symbol->string x)] 12 [(identifier? x) (symbol->string (syntax-e x))] 13 [else (error '->string)])) 14 (string->symbol (apply string-append (map ->string args)))) 15 16 ;; not in notify.rkt because notify depends on gui 17 (define-interface-expander methods:notify 18 (lambda (stx) 19 (syntax-case stx () 20 [(_ name ...) 21 (datum->syntax #f 22 (apply append 23 (for/list ([name (syntax->list #'(name ...))]) 24 (list ;; (join "init-" #'name) 25 (join "get-" name) 26 (join "set-" name) 27 (join "listen-" name)))))]))) 28 29 ;; Interfaces 30 31 ;; config<%> 32 (define-interface config<%> () 33 ((methods:notify suffix-option 34 syntax-font-size 35 colors 36 width 37 height 38 props-percentage 39 props-shown?))) 40 41 ;; displays-manager<%> 42 (define-interface displays-manager<%> () 43 (;; add-syntax-display : display<%> -> void 44 add-syntax-display 45 46 ;; remove-all-syntax-displays : -> void 47 remove-all-syntax-displays 48 49 ;; refresh-all-displays : -> void 50 refresh-all-displays)) 51 52 ;; selection-manager<%> 53 (define-interface selection-manager<%> () 54 (;; selected-syntax : notify-box of syntax/#f 55 (methods:notify selected-syntax))) 56 57 ;; relation<%> 58 (define-interface relation<%> () 59 (;; identifier=? : notify-box of (U #f (id id -> bool)) 60 (methods:notify identifier=?) 61 ;; primary-partition-factory : notify-box of (-> partition%) 62 ;; primary-partition : notify-box of partition% 63 (methods:notify primary-partition-factory) 64 (methods:notify primary-partition) 65 reset-primary-partition)) 66 67 ;; controller<%> 68 (define-interface controller<%> (displays-manager<%> 69 selection-manager<%> 70 relation<%>) 71 ()) 72 73 74 ;; host<%> 75 (define-interface host<%> () 76 (;; get-controller : -> controller<%> 77 get-controller 78 79 ;; add-keymap : text snip 80 add-keymap)) 81 82 ;; keymap/popup<%> 83 (define-interface keymap/popup<%> () 84 (;; add-context-menu-items : popup-menu -> void 85 add-context-menu-items)) 86 87 ;; display<%> 88 (define-interface display<%> () 89 (;; refresh : -> void 90 refresh 91 92 ;; highlight-syntaxes : (list-of syntax) color -> void 93 highlight-syntaxes 94 95 ;; underline-syntaxes : (listof syntax) -> void 96 underline-syntaxes 97 98 ;; get-start-position : -> number 99 get-start-position 100 101 ;; get-end-position : -> number 102 get-end-position 103 104 ;; get-range : -> range<%> 105 get-range)) 106 107 ;; range<%> 108 (define-interface range<%> () 109 (;; get-ranges : datum -> (list-of (cons number number)) 110 get-ranges 111 112 ;; get-treeranges : -> (listof TreeRange) 113 get-treeranges 114 115 ;; all-ranges : (list-of Range) 116 ;; Sorted outermost-first 117 all-ranges 118 119 ;; get-identifier-list : (list-of identifier) 120 get-identifier-list)) 121 122 123 ;; A Range is (make-range datum number number) 124 (define-struct range (obj start end)) 125 126 ;; A TreeRange is (make-treerange syntax nat nat (listof TreeRange)) 127 ;; where subs are disjoint, in order, and all contained within [start, end] 128 (define-struct treerange (obj start end subs)) 129 130 ;; syntax-prefs<%> 131 (define-interface syntax-prefs<%> () 132 (pref:width 133 pref:height 134 pref:props-percentage 135 pref:props-shown?)) 136 137 ;; widget-hooks<%> 138 (define-interface widget-hooks<%> () 139 (;; setup-keymap : -> void 140 setup-keymap 141 142 ;; shutdown : -> void 143 shutdown)) 144 145 ;; keymap-hooks<%> 146 (define-interface keymap-hooks<%> () 147 (;; make-context-menu : -> context-menu<%> 148 make-context-menu 149 150 ;; get-context-menu% : -> class 151 get-context-menu%)) 152 153 ;; context-menu-hooks<%> 154 (define-interface context-menu-hooks<%> () 155 (add-edit-items 156 after-edit-items 157 add-selection-items 158 after-selection-items 159 add-partition-items 160 after-partition-items)) 161 162 163 ;;---------- 164 165 ;; Convenience widget, specialized for displaying stx and not much else 166 (define-interface syntax-browser<%> () 167 (add-syntax 168 add-text 169 add-error-text 170 add-clickback 171 add-separator 172 erase-all 173 get-controller 174 get-text)) 175 176 (define-interface partition<%> () 177 (;; get-partition : any -> number 178 get-partition 179 180 ;; same-partition? : any any -> number 181 same-partition? 182 183 ;; count : -> number 184 count))