101 lines
2.8 KiB
Scheme
101 lines
2.8 KiB
Scheme
|
|
#lang scheme/base
|
|
(require scheme/class
|
|
scheme/unit
|
|
scheme/list
|
|
scheme/match
|
|
scheme/gui
|
|
framework/framework
|
|
syntax/boundmap
|
|
"interfaces.ss"
|
|
"prefs.ss"
|
|
"warning.ss"
|
|
"hiding-panel.ss"
|
|
(prefix-in s: "../syntax-browser/widget.ss")
|
|
(prefix-in s: "../syntax-browser/keymap.ss")
|
|
"../model/deriv.ss"
|
|
"../model/deriv-util.ss"
|
|
"../model/trace.ss"
|
|
"../model/steps.ss"
|
|
"cursor.ss"
|
|
"../util/notify.ss")
|
|
(provide stepper-keymap%
|
|
stepper-syntax-widget%)
|
|
|
|
;; Extensions
|
|
|
|
(define stepper-keymap%
|
|
(class s:syntax-keymap%
|
|
(init-field macro-stepper)
|
|
(inherit-field config
|
|
controller
|
|
the-context-menu)
|
|
(inherit add-function
|
|
call-function)
|
|
|
|
(define show-macro #f)
|
|
(define hide-macro #f)
|
|
|
|
(super-new)
|
|
|
|
(define/public (get-hiding-panel)
|
|
(send macro-stepper get-macro-hiding-prefs))
|
|
|
|
(add-function "hiding:show-macro"
|
|
(lambda (i e)
|
|
(send* (get-hiding-panel)
|
|
(add-show-identifier)
|
|
(refresh))))
|
|
|
|
(add-function "hiding:hide-macro"
|
|
(lambda (i e)
|
|
(send* (get-hiding-panel)
|
|
(add-hide-identifier)
|
|
(refresh))))
|
|
|
|
;; Menu
|
|
|
|
(inherit add-separator)
|
|
|
|
(define/override (after-selection-items)
|
|
(super after-selection-items)
|
|
(add-separator)
|
|
(set! show-macro
|
|
(new menu-item% (label "Show selected identifier") (parent the-context-menu)
|
|
(callback (lambda (i e)
|
|
(call-function "hiding:show-macro" i e)))))
|
|
(set! hide-macro
|
|
(new menu-item% (label "Hide selected identifier") (parent the-context-menu)
|
|
(callback (lambda (i e)
|
|
(call-function "hiding:hide-macro" i e)))))
|
|
(enable/disable-hide/show #f)
|
|
(void))
|
|
|
|
(define/private (enable/disable-hide/show ?)
|
|
(send show-macro enable ?)
|
|
(send hide-macro enable ?))
|
|
|
|
(send controller listen-selected-syntax
|
|
(lambda (stx)
|
|
(enable/disable-hide/show (identifier? stx))))))
|
|
|
|
(define stepper-syntax-widget%
|
|
(class s:widget%
|
|
(init-field macro-stepper)
|
|
(inherit get-text)
|
|
(inherit-field controller)
|
|
|
|
(define/override (setup-keymap)
|
|
(new stepper-keymap%
|
|
(editor (get-text))
|
|
(config (send macro-stepper get-config))
|
|
(controller controller)
|
|
(macro-stepper macro-stepper)))
|
|
|
|
(define/override (show-props show?)
|
|
(super show-props show?)
|
|
(send macro-stepper update/preserve-view))
|
|
|
|
(super-new
|
|
(config (send macro-stepper get-config)))))
|