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