66 lines
1.9 KiB
Scheme
66 lines
1.9 KiB
Scheme
|
|
(module tabbable-text mzscheme
|
|
|
|
(require
|
|
(lib "class.ss")
|
|
(lib "list.ss")
|
|
(lib "etc.ss")
|
|
(lib "framework.ss" "framework")
|
|
(lib "mred.ss" "mred")
|
|
(lib "contract.ss"))
|
|
|
|
(define tabbable-text<%>
|
|
(interface ()
|
|
#;(-> void)
|
|
;; Takes the caret into this text
|
|
|
|
set-caret-owner
|
|
#;((-> void) . -> . void)
|
|
;; The thunk to execute when tabbing ahead
|
|
set-ahead
|
|
|
|
#;((-> void) . -> . void)
|
|
;; The thunk to execute when tabbing back
|
|
set-back))
|
|
|
|
(provide/contract
|
|
(tabbable-text<%> interface?)
|
|
(tabbable-text-mixin mixin-contract)
|
|
(set-tabbing (() (listof (is-a?/c tabbable-text<%>)) . ->* . (void?))))
|
|
|
|
(define tabbable-text-mixin
|
|
(mixin (editor:keymap<%>) (tabbable-text<%>)
|
|
|
|
(init-field
|
|
[ahead void]
|
|
[back void])
|
|
|
|
#;(-> (listof keymap%))
|
|
;; the list of keymaps associated with this text
|
|
(define/override (get-keymaps)
|
|
(let ([keymap (make-object keymap%)])
|
|
(send keymap add-function "tab-ahead"
|
|
(lambda (ignored event) (ahead)))
|
|
(send keymap map-function ":tab" "tab-ahead")
|
|
(send keymap add-function "tab-back"
|
|
(lambda (ignored event) (back)))
|
|
(send keymap map-function "s:tab" "tab-back")
|
|
(cons keymap (super get-keymaps))))
|
|
|
|
(define/public (set-ahead t) (set! ahead t))
|
|
(define/public (set-back t) (set! back t))
|
|
|
|
(super-new)))
|
|
|
|
;; sets the tabbing of all of the texts in the order of the list
|
|
(define (set-tabbing . l)
|
|
(cond
|
|
[(or (empty? l) (empty? (rest l))) (void)]
|
|
[else
|
|
(send (first l) set-ahead
|
|
(lambda () (send (second l) set-caret-owner false 'global)))
|
|
(send (second l) set-back
|
|
(lambda () (send (first l) set-caret-owner false 'global)))
|
|
(apply set-tabbing (rest l))]))
|
|
)
|