This commit is contained in:
Robby Findler 2016-08-16 13:31:10 -05:00
parent 0e99b1f286
commit d0376db70a

View File

@ -504,12 +504,6 @@
[else [else
(+ i 1)]))) (+ i 1)])))
(public tabify-all insert-return calc-last-para
box-comment-out-selection comment-out-selection uncomment-selection
flash-forward-sexp
flash-backward-sexp backward-sexp find-up-sexp up-sexp find-down-sexp down-sexp
remove-parens-forward)
(define/public (get-limit pos) 0) (define/public (get-limit pos) 0)
(define/public (balance-parens key-event [smart-skip #f]) (define/public (balance-parens key-event [smart-skip #f])
@ -813,8 +807,8 @@
(when (< first-para end-para) (when (< first-para end-para)
(end-busy-cursor))))))) (end-busy-cursor)))))))
(define (tabify-all) (tabify-selection 0 (last-position))) (define/public (tabify-all) (tabify-selection 0 (last-position)))
(define (insert-return) (define/public (insert-return)
(begin-edit-sequence #t #f) (begin-edit-sequence #t #f)
(define end-of-whitespace (get-start-position)) (define end-of-whitespace (get-start-position))
(define start-cutoff (define start-cutoff
@ -838,7 +832,7 @@
new-pos)))) new-pos))))
(end-edit-sequence)) (end-edit-sequence))
(define (calc-last-para last-pos) (define/public (calc-last-para last-pos)
(let ([last-para (position-paragraph last-pos #t)]) (let ([last-para (position-paragraph last-pos #t)])
(if (and (> last-pos 0) (if (and (> last-pos 0)
(> last-para 0)) (> last-para 0))
@ -849,8 +843,7 @@
last-para))) last-para)))
last-para))) last-para)))
(define comment-out-selection (define/public (comment-out-selection [start-pos (get-start-position)]
(lambda ([start-pos (get-start-position)]
[end-pos (get-end-position)]) [end-pos (get-end-position)])
(begin-edit-sequence) (begin-edit-sequence)
(let ([first-pos-is-first-para-pos? (let ([first-pos-is-first-para-pos?
@ -868,10 +861,9 @@
(paragraph-start-position (position-paragraph (get-start-position))) (paragraph-start-position (position-paragraph (get-start-position)))
(get-end-position)))) (get-end-position))))
(end-edit-sequence) (end-edit-sequence)
#t)) #t)
(define box-comment-out-selection (define/public (box-comment-out-selection [_start-pos 'start]
(lambda ([_start-pos 'start]
[_end-pos 'end]) [_end-pos 'end])
(let ([start-pos (if (eq? _start-pos 'start) (let ([start-pos (if (eq? _start-pos 'start)
(get-start-position) (get-start-position)
@ -897,7 +889,7 @@
(insert cb start-pos) (insert cb start-pos)
(set-position start-pos start-pos)) (set-position start-pos start-pos))
(end-edit-sequence) (end-edit-sequence)
#t))) #t))
;; uncomment-box/selection : -> void ;; uncomment-box/selection : -> void
;; uncomments a comment box, if the focus is inside one. ;; uncomments a comment box, if the focus is inside one.
@ -917,8 +909,7 @@
(end-edit-sequence) (end-edit-sequence)
#t) #t)
(define uncomment-selection (define/public (uncomment-selection [start-pos (get-start-position)]
(lambda ([start-pos (get-start-position)]
[end-pos (get-end-position)]) [end-pos (get-end-position)])
(let ([snip-before (find-snip start-pos 'before-or-none)] (let ([snip-before (find-snip start-pos 'before-or-none)]
[snip-after (find-snip start-pos 'after-or-none)]) [snip-after (find-snip start-pos 'after-or-none)])
@ -954,7 +945,7 @@
(delete first-on-para (+ first-on-para 1))) (delete first-on-para (+ first-on-para 1)))
(para-loop (add1 curr-para))))))]) (para-loop (add1 curr-para))))))])
(end-edit-sequence)) (end-edit-sequence))
#t)) #t)
;; extract-contents : number (is-a?/c comment-box:snip%) -> void ;; extract-contents : number (is-a?/c comment-box:snip%) -> void
;; copies the contents of the comment-box-snip out of the snip ;; copies the contents of the comment-box-snip out of the snip
@ -1032,13 +1023,12 @@
(set-position end-pos) (set-position end-pos)
(bell)) (bell))
#t)) #t))
[define flash-forward-sexp (define/public (flash-forward-sexp start-pos)
(λ (start-pos)
(let ([end-pos (get-forward-sexp start-pos)]) (let ([end-pos (get-forward-sexp start-pos)])
(if end-pos (if end-pos
(flash-on end-pos (add1 end-pos)) (flash-on end-pos (add1 end-pos))
(bell)) (bell))
#t))] #t))
(define/public (get-backward-sexp start-pos) (define/public (get-backward-sexp start-pos)
(let* ([limit (get-limit start-pos)] (let* ([limit (get-limit start-pos)]
[end-pos (backward-match start-pos limit)] [end-pos (backward-match start-pos limit)]
@ -1057,22 +1047,19 @@
end-pos))) end-pos)))
;; can't go backward at all: ;; can't go backward at all:
#f))) #f)))
[define flash-backward-sexp (define/public (flash-backward-sexp start-pos)
(λ (start-pos)
(let ([end-pos (get-backward-sexp start-pos)]) (let ([end-pos (get-backward-sexp start-pos)])
(if end-pos (if end-pos
(flash-on end-pos (add1 end-pos)) (flash-on end-pos (add1 end-pos))
(bell)) (bell))
#t))] #t))
[define backward-sexp (define/public (backward-sexp start-pos)
(λ (start-pos)
(let ([end-pos (get-backward-sexp start-pos)]) (let ([end-pos (get-backward-sexp start-pos)])
(if end-pos (if end-pos
(set-position end-pos) (set-position end-pos)
(bell)) (bell))
#t))] #t))
[define find-up-sexp (define/public (find-up-sexp start-pos)
(λ (start-pos)
(let* ([limit-pos (get-limit start-pos)] (let* ([limit-pos (get-limit start-pos)]
[exp-pos [exp-pos
(backward-containing-sexp start-pos limit-pos)]) (backward-containing-sexp start-pos limit-pos)])
@ -1097,16 +1084,14 @@
(if (null? poss) ;; all finds failed (if (null? poss) ;; all finds failed
#f #f
(- (apply max poss) 1)))) ;; subtract one to move outside the paren (- (apply max poss) 1)))) ;; subtract one to move outside the paren
#f)))] #f)))
[define up-sexp (define/public (up-sexp start-pos)
(λ (start-pos)
(let ([exp-pos (find-up-sexp start-pos)]) (let ([exp-pos (find-up-sexp start-pos)])
(if exp-pos (if exp-pos
(set-position exp-pos) (set-position exp-pos)
(bell)) (bell))
#t))] #t))
[define find-down-sexp (define/public (find-down-sexp start-pos)
(λ (start-pos)
(let loop ([pos start-pos]) (let loop ([pos start-pos])
(let ([next-pos (get-forward-sexp pos)]) (let ([next-pos (get-forward-sexp pos)])
(if (and next-pos (> next-pos pos)) (if (and next-pos (> next-pos pos))
@ -1116,16 +1101,14 @@
(> back-pos pos)) (> back-pos pos))
back-pos back-pos
(loop next-pos))) (loop next-pos)))
#f))))] #f))))
[define down-sexp (define/public (down-sexp start-pos)
(λ (start-pos)
(let ([pos (find-down-sexp start-pos)]) (let ([pos (find-down-sexp start-pos)])
(if pos (if pos
(set-position pos) (set-position pos)
(bell)) (bell))
#t))] #t))
[define remove-parens-forward (define/public (remove-parens-forward start-pos)
(λ (start-pos)
(let* ([pos (skip-whitespace start-pos 'forward #f)] (let* ([pos (skip-whitespace start-pos 'forward #f)]
[first-char (get-character pos)] [first-char (get-character pos)]
[paren? (or (char=? first-char #\() [paren? (or (char=? first-char #\()
@ -1139,7 +1122,7 @@
(delete (- closer 2) (- closer 1)) (delete (- closer 2) (- closer 1))
(end-edit-sequence)) (end-edit-sequence))
(bell)) (bell))
#t))] #t))
(define/private (select-text f forward?) (define/private (select-text f forward?)
(define start-pos (get-start-position)) (define start-pos (get-start-position))
@ -1156,11 +1139,11 @@
(extend-position new-pos) (extend-position new-pos)
(bell)) (bell))
#t) #t)
(public select-forward-sexp select-backward-sexp select-up-sexp select-down-sexp)
[define select-forward-sexp (λ () (select-text (λ (x) (get-forward-sexp x)) #t))] (define/public (select-forward-sexp) (select-text (λ (x) (get-forward-sexp x)) #t))
[define select-backward-sexp (λ () (select-text (λ (x) (get-backward-sexp x)) #f))] (define/public (select-backward-sexp) (select-text (λ (x) (get-backward-sexp x)) #f))
[define select-up-sexp (λ () (select-text (λ (x) (find-up-sexp x)) #f))] (define/public (select-up-sexp) (select-text (λ (x) (find-up-sexp x)) #f))
[define select-down-sexp (λ () (select-text (λ (x) (find-down-sexp x)) #t))] (define/public (select-down-sexp) (select-text (λ (x) (find-down-sexp x)) #t))
(define/public (introduce-let-ans pos) (define/public (introduce-let-ans pos)
(dynamic-wind (dynamic-wind
@ -1306,10 +1289,9 @@
(for-each (λ (s) (insert s start-1)) snips-2/rev) (for-each (λ (s) (insert s start-1)) snips-2/rev)
(set-position end-2) (set-position end-2)
(end-edit-sequence))))))))))) (end-edit-sequence)))))))))))
[define tab-size 8] (define tab-size 8)
(public get-tab-size set-tab-size) (define/public (get-tab-size) tab-size)
[define get-tab-size (λ () tab-size)] (define/public (set-tab-size s) (set! tab-size s))
[define set-tab-size (λ (s) (set! tab-size s))]
(define/override (get-start-of-line pos) (define/override (get-start-of-line pos)
(define para (position-paragraph pos)) (define para (position-paragraph pos))