Commit aa4291a5 authored by Dan Holtby's avatar Dan Holtby
Browse files

handle pastes properly, add preferences and dialog

parent e0a3e2af
...@@ -4,6 +4,7 @@ ...@@ -4,6 +4,7 @@
racket/gui/base racket/gui/base
racket/unit racket/unit
framework framework
string-constants
mrlib/switchable-button) mrlib/switchable-button)
(provide tool@) (provide tool@)
...@@ -13,7 +14,7 @@ ...@@ -13,7 +14,7 @@
(export drracket:tool-exports^) (export drracket:tool-exports^)
(define block-WXME-mixin (define block-WXME-mixin
(mixin ((class->interface text%)) () (mixin (text:basic<%>) ()
(inherit begin-edit-sequence (inherit begin-edit-sequence
get-snip-position get-snip-position
...@@ -21,76 +22,126 @@ ...@@ -21,76 +22,126 @@
find-snip find-snip
split-snip split-snip
end-edit-sequence end-edit-sequence
get-top-level-window
insert insert
delete delete
get-text) get-text)
(define updating #f) (define updating #f) ; whether current insert is being done by the wxme->text code
(define undoing #f) ; whether current insert is being done by undo/redo
(define paste-info #f) ; whether current insert is being done as part of a paste
(define/public (ask-convert?)
(cond
[(preferences:get 'framework:ask-about-wxme-conversion)
(define-values (mbr checked?)
(message+check-box/custom
(string-constant drscheme)
"The string you inserted contains fractions or other non-text elements. Convert them to text?"
(string-constant dont-ask-again)
"Convert to text"
(string-constant leave-alone)
#f
(get-top-level-window)
(cons (if (preferences:get 'framework:do-wxme-conversion)
'default=1
'default=2)
'(caution))
2))
(define convert? (not (equal? 2 mbr)))
(preferences:set 'framework:ask-about-wxme-conversion (not checked?))
(preferences:set 'framework:do-wxme-conversion convert?)
convert?]
[else
(preferences:get 'framework:do-wxme-conversion)]))
(define/augment (on-insert start len) ;; copied from text-normalize-paste. Seems to work
;(eprintf "(on-insert ~a ~a) (in-edit-sequence?) => ~a\n" start len (send this in-edit-sequence?)) (define (as-a-paste thunk)
(inner (void) on-insert start len)) (dynamic-wind
(λ () (set! paste-info #t))
(λ ()
(thunk)
(define local-paste-info paste-info)
(set! paste-info #f)
(deal-with-paste local-paste-info))
;; use the dynamic wind to be sure that the paste-info is set back to #f
;; in the case that the middle thunk raises an exception
(λ () (set! paste-info #f))))
(define/override (do-paste start the-time)
(as-a-paste (λ () (super do-paste start the-time))))
(define/augment (after-insert start len) (define/augment (after-insert start len)
(inner (void) after-insert start len) (inner (void) after-insert start len)
(unless updating (check-range start (+ start len))) ;; It didn't seem to work if I updated one snip at a time, so it just logs the whole
;; modified range and replaces the non-text snips in one pass
) (cond [(pair? paste-info)
(set! paste-info (cons (min (car paste-info) start)
(max (cdr paste-info) (+ start len))))]
[paste-info
(set! paste-info (cons start (+ start len)))]
[(not updating) (check-range start (+ start len))]))
(define undoing #f)
(define/private (deal-with-paste local-paste-info)
(when (pair? local-paste-info)
(check-range (car local-paste-info) (cdr local-paste-info))))
;; (check-range start stop) replaces the snips from start to stop with
;; a single string snip, converting number snips to plain text literals
;; and replacign all other non-string snips with comments
;; If currently undoing / redoing, check-range does nothing (otherwise the undo/redo will
;; convert the text twice, once here and then again as part of the chained edit sequence that
;; this method already added
;; TODO: replace comment boxes with block comments?
;; check-range: Nat Nat -> Void
(define/private (check-range start stop) (define/private (check-range start stop)
(split-snip start) (unless undoing
(split-snip stop) (split-snip start)
(let loop ([snip (find-snip start 'after-or-none)] (split-snip stop)
[new-text (open-output-string)] (let loop ([snip (find-snip start 'after-or-none)]
[changed? #f]) [new-text (open-output-string)]
(cond [(or (not snip) (<= stop (get-snip-position snip))) [changed? #f])
(cond [(or (not snip) (<= stop (get-snip-position snip)))
(when (and changed? (not undoing)) (when (and changed? (ask-convert?))
(let ([s (get-output-string new-text)]) (let ([s (get-output-string new-text)])
;(eprintf "Base case : ~v [~v:~v]\n" s start stop) (set! updating #t)
(send this add-undo
(set! updating #t) (lambda ()
(send this add-undo (set! undoing #f)
(lambda () #t))
(set! undoing #f) (send this add-undo
#t)) (lambda ()
(send this add-undo (set! undoing #t)
(lambda () #t))
(set! undoing #t) (begin-edit-sequence #f #t) ; these go before the change so that
#t)) (delete start stop #f) ; a redo is marked
(begin-edit-sequence #f #t) (end-edit-sequence)
;(set-position start stop) (begin-edit-sequence #t #f)
;(send this undo) (set-position start stop)
(delete start stop #f) (insert (get-output-string new-text) start 'same #f)
(end-edit-sequence) (end-edit-sequence)
(begin-edit-sequence #t #f) (send this add-undo ; these go after the change, so an undo is marked
(set-position start stop) (lambda ()
(insert (get-output-string new-text) start 'same #f) (set! undoing #t)
(end-edit-sequence) #t))
(send this add-undo (send this add-undo
(lambda () (lambda ()
(set! undoing #t) (set! undoing #f)
#t)) #t))
(send this add-undo (set! updating #f)))]
(lambda () [(is-a? snip string-snip%)
(set! undoing #f) (display (send snip get-text 0 (send snip get-count)) new-text)
#t)) (loop (send snip next) new-text changed?)]
(set! updating #f) [else ; to any CS135 students reading this: else cond isn't terrible in full Racket because of side effects ;)
) (cond [(number-snip:is-number-snip? snip)
) (write (number-snip:get-number snip) new-text)]
] [else (fprintf new-text "#|Failed to insert ~v|#" snip)])
[(is-a? snip string-snip%) (loop (send snip next)
(display (send snip get-text 0 (send snip get-count)) new-text) new-text
(loop (send snip next) new-text changed?)] #t)]))))
[else
(cond [(number-snip:is-number-snip? snip)
(write (number-snip:get-number snip) new-text)]
[else (fprintf new-text "#|Failed to insert ~v|#" snip)])
(loop (send snip next)
new-text
#t)])))
(super-new))) (super-new)))
...@@ -102,5 +153,15 @@ ...@@ -102,5 +153,15 @@
(define (phase1) (void)) (define (phase1) (void))
(define (phase2) (void)) (define (phase2) (void))
(preferences:set-default 'framework:ask-about-wxme-conversion #t boolean?)
(preferences:set-default 'framework:do-wxme-conversion #t boolean?)
(preferences:add-to-editor-checkbox-panel
(λ (editor-panel)
(preferences:add-check editor-panel
'framework:ask-about-wxme-conversion
"Ask before converting graphics to plain text")
(preferences:add-check editor-panel
'framework:do-wxme-conversion
"Convert graphics to plain text")))
(drracket:get/extend:extend-definitions-text block-WXME-mixin))) (drracket:get/extend:extend-definitions-text block-WXME-mixin)))
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment