85 lines
2.6 KiB
Racket
85 lines
2.6 KiB
Racket
#lang racket/base
|
|
(require racket/class
|
|
racket/gui/base
|
|
unstable/class-iop
|
|
"interfaces.rkt"
|
|
(prefix-in s: "../syntax-browser/widget.rkt")
|
|
(prefix-in s: "../syntax-browser/keymap.rkt"))
|
|
(provide stepper-keymap%
|
|
stepper-syntax-widget%)
|
|
|
|
;; Extensions
|
|
|
|
(define stepper-keymap%
|
|
(class s:syntax-keymap%
|
|
(init-field/i (macro-stepper widget<%>))
|
|
(inherit-field config
|
|
controller)
|
|
(inherit add-function
|
|
map-function
|
|
call-function)
|
|
|
|
(define show-macro #f)
|
|
(define hide-macro #f)
|
|
|
|
(super-new)
|
|
|
|
(define/public (get-hiding-panel)
|
|
(send/i macro-stepper widget<%> get-macro-hiding-prefs))
|
|
|
|
(map-function ":s" "hiding:show-macro")
|
|
(map-function ":h" "hiding:hide-macro")
|
|
|
|
(add-function "hiding:show-macro"
|
|
(lambda (i e)
|
|
(send*/i (get-hiding-panel) hiding-prefs<%>
|
|
(add-show-identifier)
|
|
(refresh))))
|
|
|
|
(add-function "hiding:hide-macro"
|
|
(lambda (i e)
|
|
(send*/i (get-hiding-panel) hiding-prefs<%>
|
|
(add-hide-identifier)
|
|
(refresh))))
|
|
|
|
;; Menu
|
|
|
|
(define/override (add-context-menu-items menu)
|
|
(super add-context-menu-items menu)
|
|
(new separator-menu-item% (parent menu))
|
|
(new menu-item% (label "Show selected identifier") (parent menu)
|
|
(demand-callback
|
|
(lambda (i)
|
|
(send i enable (identifier? (send controller get-selected-syntax)))))
|
|
(callback
|
|
(lambda (i e)
|
|
(call-function "hiding:show-macro" i e))))
|
|
(new menu-item% (label "Hide selected identifier") (parent menu)
|
|
(demand-callback
|
|
(lambda (i)
|
|
(send i enable (identifier? (send controller get-selected-syntax)))))
|
|
(callback
|
|
(lambda (i e) (call-function "hiding:hide-macro" i e)))))))
|
|
|
|
|
|
(define stepper-syntax-widget%
|
|
(class s:widget%
|
|
(init-field/i (macro-stepper widget<%>))
|
|
(inherit get-text)
|
|
(inherit-field controller)
|
|
|
|
(define/override (setup-keymap)
|
|
(new stepper-keymap%
|
|
(editor (get-text))
|
|
(config (send/i macro-stepper widget<%> get-config))
|
|
(controller controller)
|
|
(macro-stepper macro-stepper)))
|
|
|
|
(define/override (show-props show?)
|
|
(super show-props show?)
|
|
(when (send (send/i macro-stepper widget<%> get-config) get-refresh-on-resize?)
|
|
(send/i macro-stepper widget<%> update/preserve-view)))
|
|
|
|
(super-new
|
|
(config (send/i macro-stepper widget<%> get-config)))))
|