[plt-scheme] can't get undo (from add-text-keymap-functions) working

From: Martin DeMello (martindemello at gmail.com)
Date: Sun Apr 5 02:15:36 EDT 2009

I have inherited a class from text%, and assigned it a keymap. The
keymap has been seeded with add-text-keymap-functions. However,
undo/redo don't work - is there anything extra I need to add to get
undo support? Here's the relevant code (I've pasted the full class in,
in case something else is interfering with undo):

(define editor-keymap
  (let ((keymap (make-object keymap%)))
    (add-text-keymap-functions keymap)
    (send keymap map-function "c:left" "backward-word")
    (send keymap map-function "c:right" "forward-word")
    (send keymap map-function "s:c:left" "backward-select-word")
    (send keymap map-function "s:c:right" "forward-select-word")
    (send keymap map-function "c:insert" "copy-clipboard")
    (send keymap map-function "s:insert" "paste-clipboard")
    (send keymap map-function "c:z" "undo")
    (send keymap map-function "c:y" "redo")
    keymap))

(define editable-text%
  (class text%
    (init-field on-height-changed)
    (init-field next-editor)
    (init-field prev-editor)
    (init-field set-active)
    (init-field (initial-text ""))
    ;; height acts as a cache for the number of lines
    ;; so we can tell if insert/delete has changed it
    (define height 0)
    (define (set-height) (set! height (last-line)))
    (define (check-height)
      (when (<> height (last-line)) (on-height-changed)))
    (inherit last-line position-line get-start-position insert set-keymap)
    (define (current-line) (position-line (get-start-position)))
    (define (last-line?) (= (current-line) (last-line)))
    (define (first-line?) (= (current-line) 0))
    (define/public (nlines) (+ 1 (last-line)))
    (define/augment (on-insert a b) (set-height))
    (define/augment (on-delete a b) (set-height))
    (define/augment (after-insert a b) (check-height))
    (define/augment (after-delete a b) (check-height))
    (define/override (on-focus on?) (when on? (set-active)))
    (define/override (on-local-char key)
      (let ([code (send key get-key-code)])
        (cond [(and (equal? code 'down) (last-line?)) (next-editor) ]
              [(and (equal? code 'up) (first-line?)) (prev-editor) ]
              [else (super on-local-char key)])))

    ;; initialize
    (super-instantiate ())
    (set-keymap editor-keymap)
    (insert initial-text 0)
    ))

martin


Posted on the users mailing list.