#lang racket/base (require racket/class racket/gui/base racket/list racket/string racket/contract) (provide (all-defined-out)) (module+ test ;; todo: fix this so it can be tested on travis (require racket/gui/base rackunit) (define t (new text%)) (define t-str "foo\n ar\n m") (define result (send t insert-port (open-input-string t-str)))) (define indent-width 2) (define/contract (char text pos) ((is-a?/c text%) (or/c exact-nonnegative-integer? #f) . -> . (or/c char? #f)) (and pos (let ([c (send text get-character pos)]) (if (char=? #\nul c) #f c)))) (module+ test (check-equal? (char t 0) #\f) (check-equal? (char t 2) #\o) (check-equal? (char t 3) #\newline) (check-equal? (char t 10) #\m) (check-equal? (char t 11) #f)) (define/contract (line text pos) ((is-a?/c text%) (or/c exact-nonnegative-integer? #f) . -> . exact-nonnegative-integer?) (send text position-line pos)) (module+ test (check-equal? (line t 0) 0) (check-equal? (line t 2) 0) (check-equal? (line t 5) 1) (check-equal? (line t 10) 2) (check-equal? (line t 11) 2)) (define/contract (line-chars text line) ((is-a?/c text%) exact-nonnegative-integer? . -> . (or/c (listof char?) #f)) (and (valid-line? text line) (for*/list ([pos (in-range (line-start text line) (add1 (line-end text line)))] [c (in-value (char text pos))] #:when c) c))) (module+ test (check-equal? (line-chars t 0) '(#\f #\o #\o #\newline)) (check-equal? (line-chars t 1) '(#\space #\a #\r #\newline)) (check-equal? (line-chars t 2) '(#\space #\space #\m)) (check-equal? (line-chars t 3) #f)) (define/contract (previous-line text pos) ((is-a?/c text%) exact-nonnegative-integer? . -> . (or/c exact-nonnegative-integer? #f)) (define this-line (line text pos)) (and (this-line . > . 0) (sub1 this-line))) (module+ test (check-equal? (previous-line t 0) #f) (check-equal? (previous-line t 2) #f) (check-equal? (previous-line t 5) 0) (check-equal? (previous-line t 10) 1) (check-equal? (previous-line t 11) 1)) (define/contract (next-line text pos) ((is-a?/c text%) exact-nonnegative-integer? . -> . (or/c exact-nonnegative-integer? #f)) (define last (send text last-line)) (define this-line (line text pos)) (and (this-line . < . last) (add1 this-line))) (module+ test (check-equal? (next-line t 0) 1) (check-equal? (next-line t 2) 1) (check-equal? (next-line t 5) 2) (check-equal? (next-line t 10) #f) (check-equal? (next-line t 11) #f)) (define/contract (valid-line? text line) ((is-a?/c text%) (or/c exact-nonnegative-integer? #f) . -> . boolean?) (and line (<= 0 line (send text last-line)))) (define/contract (line-start text line) ((is-a?/c text%) (or/c exact-nonnegative-integer? #f) . -> . (or/c exact-nonnegative-integer? #f)) (and (valid-line? text line) (send text line-start-position line))) (module+ test (check-equal? (line-start t 0) 0) (check-equal? (line-start t 1) 4) (check-equal? (line-start t 2) 8) (check-equal? (line-start t 3) #f)) (define/contract (line-end text line) ((is-a?/c text%) (or/c exact-nonnegative-integer? #f) . -> . (or/c exact-nonnegative-integer? #f)) (and (valid-line? text line) (send text line-end-position line))) (module+ test (check-equal? (line-end t 0) 3) (check-equal? (line-end t 1) 7) (check-equal? (line-end t 2) 11) (check-equal? (line-end t 3) #f)) (define (first-visible-char-pos text start end) ;; private (for*/first ([pos (in-range start end (if (start . > . end) -1 1))] [c (in-value (char text pos))] #:when (not (char-blank? c))) pos)) (define/contract (line-start-visible text line) ((is-a?/c text%) (or/c exact-nonnegative-integer? #f) . -> . (or/c exact-nonnegative-integer? #f)) (define start (line-start text line)) (define end (line-end text line)) (and start end (first-visible-char-pos text start end))) (module+ test (check-equal? (line-start-visible t 0) 0) (check-equal? (line-start-visible t 1) 5) (check-equal? (line-start-visible t 2) 10) (check-equal? (line-start-visible t 3) #f)) (define/contract (line-first-visible-char text line) ((is-a?/c text%) (or/c exact-nonnegative-integer? #f) . -> . (or/c char? #f)) (char text (line-start-visible text line))) (define/contract (line-last-visible-char text line) ((is-a?/c text%) (or/c exact-nonnegative-integer? #f) . -> . (or/c char? #f)) (char text (line-end-visible text line))) (define/contract (line-end-visible text line) ((is-a?/c text%) (or/c exact-nonnegative-integer? #f) . -> . (or/c exact-nonnegative-integer? #f)) (define start+1 (line-end text line)) ; start before newline (define end+1 (line-start text line)) (and start+1 end+1 (first-visible-char-pos text (sub1 start+1) (sub1 end+1)))) (module+ test (check-equal? (line-end-visible t 0) 2) (check-equal? (line-end-visible t 1) 6) (check-equal? (line-end-visible t 2) 10) (check-equal? (line-end-visible t 3) #f)) (define/contract (line-indent text line) ((is-a?/c text%) (or/c exact-nonnegative-integer? #f) . -> . (or/c exact-nonnegative-integer? #f)) (and (valid-line? text line) (let ([lsv (line-start-visible text line)]) (and lsv ; could be #f (let ([li (- (line-start-visible text line) (line-start text line))]) (and (positive? li) li)))))) (module+ test (check-equal? (line-indent t 0) #f) (check-equal? (line-indent t 1) 1) (check-equal? (line-indent t 2) 2) (check-equal? (line-indent t 3) #f)) (define (count-char text c [start 0] [end (send text last-position)]) (for*/sum ([pos (in-range start (add1 end))] [d (in-value (char text pos))] #:when (and d (d . char=? . c))) 1)) (module+ test (check-equal? (count-char t #\f) 1) (check-equal? (count-char t #\o) 2) (check-equal? (count-char t #\o 0 1) 1) (check-equal? (count-char t #\newline) 2)) (define (str->text str) (define t (new text%)) (send t insert-port (open-input-string str)) t) (define (space-char? x) (char=? x #\space)) (define/contract (apply-indenter indenter t-or-str) (procedure? (or/c (is-a?/c text%) string?) . -> . string?) (define t (if (string? t-or-str) (str->text t-or-str) t-or-str)) (define indented-t (for/fold ([t-acc t]) ([line-idx (in-range (add1 (send t last-line)))]) ;; simulate DrR indentation ;; by dropping leading spaces and applying new indent. (define line-start-pos (line-start t-acc line-idx)) (define new-indent (indenter t-acc line-start-pos)) (define new-line-str (list->string (append (make-list (or new-indent 0) #\space) (dropf (line-chars t-acc line-idx) space-char?)))) (send t-acc delete line-start-pos (add1 (line-end t-acc line-idx))) ; add1 to grab ending newline too (send t-acc insert new-line-str line-start-pos) t-acc)) (send indented-t get-text)) (define/contract (string-indents str) (string? . -> . (listof (or/c exact-positive-integer? #f))) (for/list ([line (in-list (string-split str "\n"))]) (define len (length (takef (string->list line) space-char?))) (and (exact-positive-integer? len) len))) (module+ test (check-equal? (string-indents t-str) '(#f 1 2)))