From 3e4009f20f6dd18ac2dbf99887ed225c295f6827 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 11 Sep 2023 10:19:40 -0500 Subject: [PATCH] improve racket:text's comment-related functionality --- gui-doc/scribblings/framework/racket.scrbl | 128 +++++++-- gui-lib/framework/private/racket.rkt | 313 +++++++++++++++------ gui-lib/info.rkt | 2 +- gui-test/framework/tests/racket.rkt | 105 ++++++- 4 files changed, 427 insertions(+), 121 deletions(-) diff --git a/gui-doc/scribblings/framework/racket.scrbl b/gui-doc/scribblings/framework/racket.scrbl index 35fca5a6f..c9f287c47 100644 --- a/gui-doc/scribblings/framework/racket.scrbl +++ b/gui-doc/scribblings/framework/racket.scrbl @@ -136,42 +136,114 @@ Deletes any trailing whitespace from the old line. } - @defmethod*[(((box-comment-out-selection - (start-pos (or/c (symbols 'start) exact-integer?)) - (end-pos (or/c (symbols 'end) exact-integer?))) - void?))]{ - This method comments out a selection in the text by putting it into a - comment box. + @defmethod[(box-comment-out-selection + [start-pos (or/c 'start exact-integer?) 'start] + [end-pos (or/c 'end exact-integer?) 'end]) + #t]{ + This method comments out a selection in the text by putting it into a + comment box. + + Removes the region from @racket[start-pos] to @racket[end-pos] from the + editor and inserts a comment box with that region of text inserted into the + box. + + If @racket[start-pos] is @racket['start], the starting point of the + selection is used. If @racket[end-pos] is @racket['end], the ending point + of the selection is used. + } - Removes the region from @racket[start-pos] to @racket[end-pos] from the - editor and inserts a comment box with that region of text inserted into the - box. + @defmethod[(comment-out-selection [start-pos exact-nonnegative-integer? (get-start-position)] + [end-pos exact-nonnegative-integer? (get-end-position)] + [#:start start (and/c string? (not/c #rx"[\r\n]")) ";"] + [#:padding padding (and/c string? (not/c #rx"[\r\n]")) ""]) + #t]{ + Comments the lines containing positions @racket[start-pos] through @racket[end-pos] + by inserting a @racket[start] followed by @racket[padding] at the + start of each paragraph. + } - If @racket[start-pos] is @racket['start], the starting point of the - selection is used. If @racket[end-pos] is @racket['end], the ending point - of the selection is used. - } + @defmethod[(region-comment-out-selection + [start-pos exact-nonnegative-integer? (get-start-position)] + [end-pos exact-nonnegative-integer? (get-end-position)] + [#:start start (and/c string? (not/c #rx"[\r\n]")) "#|"] + [#:end end (and/c string? (not/c #rx"[\r\n]")) "|#"] + [#:continue continue (and/c string? (not/c #rx"[\r\n]")) ""] + [#:padding padding (and/c string? (not/c #rx"[\r\n]")) " "]) + #t]{ + Comments the region between @racket[start-pos] and @racket[end-pos] + by inserting a @racket[start] at @racket[start-pos], @racket[end] at @racket[end-pos], + and @racket[continue] followed by @racket[padding] at the start of each paragraph + between @racket[start-pos] and @racket[end-pos]. + } - @defmethod[(comment-out-selection [start exact-integer? (get-start-position)] - [end exact-integer? (get-end-position)] - [#:start-comment start-comment string? ";"] - [#:padding padding string? ""]) - void?]{ - Comments the lines containing positions @racket[start] through @racket[end] - by inserting a @racket[start-comment] followed by @racket[padding] at the - start of each paragraph. + @defmethod[(uncomment-box/selection + [#:start start (and/c string? (not/c #rx"[\r\n]")) ";"] + [#:padding padding (and/c string? (not/c #rx"[\r\n]")) ""]) #t]{ + If the result of @method[editor<%> get-focus-snip] is a comment snip, + then removes the comment snip. Otherwise, calls @racket[uncomment-selection] + with @racket[start] and @racket[padding]. } - @defmethod[(uncomment-selection [start exact-integer? (get-start-position)] - [end exact-integer? (get-end-position)] - [#:start-comment start-comment string ";"]) void?]{ + @defmethod[(uncomment-selection [start-pos exact-nonnegative-integer? (get-start-position)] + [end-pos exact-nonnegative-integer? (get-end-position)] + [#:start start string ";"]) void?]{ Uncomments the paragraphs containing positions - @racket[start] through @racket[end]. + @racket[start-pos] through @racket[end-pos] if it has line-based comments or + a box comment. + + Specifically, checks for a box comment and, if present removes it. + If a box comment is not present, then removes line-based comments (if any) + on the paragraphs between @racket[start-pos] and @racket[end-pos]. + } - Specifically, removes each occurrence of - @racket[start-comment] that appears (potentially following + @defmethod[(uncomment-selection/box [start-pos exact-nonnegative-integer? (get-start-position)] + [end-pos exact-nonnegative-integer? (get-end-position)]) + boolean?]{ + Checks for a box comment and, if present removes it. Returns @racket[#t] if + it found (and removed) a box comment, and @racket[#f] if it did not find + a box comment. + } + + @defmethod[(uncomment-selection/line [start-pos exact-nonnegative-integer? (get-start-position)] + [end-pos exact-nonnegative-integer? (get-end-position)] + [#:start start (and/c string? (not/c #rx"[\r\n]")) ";"] + [#:padding padding (and/c string? (not/c #rx"[\r\n]")) ""]) + #t]{ + Removes each occurrence of + @racket[start] that appears (potentially following whitespace) at the start of each paragraph that enclose the - range between @racket[start] and @racket[end]. + range between @racket[start-pos] and @racket[end-pos]. + } + + @defmethod[(uncomment-selection/region [start-pos exact-nonnegative-integer? (get-start-position)] + [end-pos exact-nonnegative-integer? (get-end-position)] + [#:start start (and/c string? (not/c #rx"[\r\n]")) "#|"] + [#:end end (and/c string? (not/c #rx"[\r\n]")) "|#"] + [#:continue continue (and/c string? (not/c #rx"[\r\n]")) ""] + [#:padding padding (and/c string? (not/c #rx"[\r\n]")) " "]) + #t]{ + Removes the region comment on the paragraphs between @racket[start-pos] and @racket[end-pos]. + } + + @defmethod[(commented-out/line? [start-pos exact-nonnegative-integer? (get-start-position)] + [end-pos exact-nonnegative-integer? (get-end-position)] + [#:start start (and/c string? (not/c #rx"[\r\n]")) ";"] + [#:padding padding (and/c string? (not/c #rx"[\r\n]")) ""]) + boolean?]{ + Considers each paragraph between @racket[start-pos] and @racket[end-pos], returning + @racket[#t] if any of them have the line comment @racket[start] commenting any + portion of them out. + } + + @defmethod[(commented-out/region? [start-pos exact-nonnegative-integer? (get-start-position)] + [end-pos exact-nonnegative-integer? (get-end-position)] + [#:start start (and/c string? (not/c #rx"[\r\n]")) "#|"] + [#:end end (and/c string? (not/c #rx"[\r\n]")) "|#"] + [#:continue continue (and/c string? (not/c #rx"[\r\n]")) ""]) + boolean?]{ + Returns @racket[#t] if the paragraphs at @racket[start-pos] and @racket[end-pos] + have @racket[start] and @racket[end] in them and the paragraphs in between + start with @racket[continue]. } @defmethod*[(((get-forward-sexp (start exact-integer?)) diff --git a/gui-lib/framework/private/racket.rkt b/gui-lib/framework/private/racket.rkt index a0e5aa6a4..4844aa628 100644 --- a/gui-lib/framework/private/racket.rkt +++ b/gui-lib/framework/private/racket.rkt @@ -375,9 +375,18 @@ tabify-selection tabify-all insert-return - box-comment-out-selection + comment-out-selection + box-comment-out-selection + region-comment-out-selection + uncomment-box/selection uncomment-selection + uncomment-selection/region + uncomment-selection/line + uncomment-selection/box + commented-out/line? + commented-out/region? + get-forward-sexp remove-sexp forward-sexp @@ -702,9 +711,27 @@ last-para))) last-para))) + (define/public (region-comment-out-selection [start-pos (get-start-position)] + [end-pos (get-end-position)] + #:start [start "#|"] + #:end [end "|#"] + #:continue [continue ""] + #:padding [padding " "]) + (begin-edit-sequence) + (define start-para (position-paragraph start-pos)) + (define end-para (position-paragraph end-pos)) + (insert end end-pos) + (insert start start-pos) + (for ([i (in-range (+ start-para 1) end-para)]) + (define para-start (paragraph-start-position i)) + (insert padding para-start) + (insert continue para-start)) + (end-edit-sequence) + #t) + (define/public (comment-out-selection [start-pos (get-start-position)] [end-pos (get-end-position)] - #:start-comment [start-comment ";"] + #:start [start-comment ";"] #:padding [padding ""]) (begin-edit-sequence) (define first-pos-is-first-para-pos? @@ -727,105 +754,221 @@ (define/public (box-comment-out-selection [_start-pos 'start] [_end-pos 'end]) - (let ([start-pos (if (eq? _start-pos 'start) - (get-start-position) - _start-pos)] - [end-pos (if (eq? _end-pos 'end) - (get-end-position) - _end-pos)]) - (begin-edit-sequence) - (split-snip start-pos) - (split-snip end-pos) - (let* ([cb (instantiate comment-box:snip% ())] - [text (send cb get-editor)]) - (let loop ([snip (find-snip start-pos 'after-or-none)]) - (cond - [(not snip) (void)] - [((get-snip-position snip) . >= . end-pos) (void)] - [else - (send text insert (send snip copy) - (send text last-position) - (send text last-position)) - (loop (send snip next))])) - (delete start-pos end-pos) - (insert cb start-pos) - (set-position start-pos start-pos)) - (end-edit-sequence) - #t)) + (define start-pos (if (eq? _start-pos 'start) + (get-start-position) + _start-pos)) + (define end-pos (if (eq? _end-pos 'end) + (get-end-position) + _end-pos)) + (begin-edit-sequence) + (split-snip start-pos) + (split-snip end-pos) + (define cb (new comment-box:snip%)) + (define text (send cb get-editor)) + (let loop ([snip (find-snip start-pos 'after-or-none)]) + (cond + [(not snip) (void)] + [((get-snip-position snip) . >= . end-pos) (void)] + [else + (send text insert (send snip copy) + (send text last-position) + (send text last-position)) + (loop (send snip next))])) + (delete start-pos end-pos) + (insert cb start-pos) + (set-position start-pos start-pos) + (end-edit-sequence) + #t) ;; uncomment-box/selection : -> void ;; uncomments a comment box, if the focus is inside one. ;; otherwise, calls uncomment selection to uncomment ;; something else. (inherit get-focus-snip) - (define/public (uncomment-box/selection) + (define/public (uncomment-box/selection #:start [start ";"] #:padding [padding ""]) (begin-edit-sequence) - (let ([focus-snip (get-focus-snip)]) - (cond - [(not focus-snip) (uncomment-selection)] - [(is-a? focus-snip comment-box:snip%) - (extract-contents - (get-snip-position focus-snip) - focus-snip)] - [else (uncomment-selection)])) + (define focus-snip (get-focus-snip)) + (cond + [(not focus-snip) (uncomment-selection #:start start #:padding padding)] + [(is-a? focus-snip comment-box:snip%) + (extract-contents + (get-snip-position focus-snip) + focus-snip)] + [else (uncomment-selection #:start start #:padding padding)]) (end-edit-sequence) #t) (define/public (uncomment-selection [start-pos (get-start-position)] [end-pos (get-end-position)] - #:start-comment [start-comment ";"]) + #:start [start-comment ";"] + #:padding [padding ""]) + (or (uncomment-selection/box start-pos end-pos) + (uncomment-selection/line start-pos end-pos + #:start start-comment + #:padding padding)) + #t) + + (define/public (uncomment-selection/region [start-pos (get-start-position)] + [end-pos (get-end-position)] + #:start [start "#|"] + #:end [end "|#"] + #:continue [continue ""] + #:padding [padding " "]) + (define info + (looks-region-commented start-pos end-pos + #:start start + #:end end + #:continue continue + #:padding padding)) + (when info + (begin-edit-sequence) + (for ([region-to-remove (in-list info)]) + (delete (car region-to-remove) (cdr region-to-remove))) + (end-edit-sequence)) + #t) + + (define/public (uncomment-selection/line [start-pos (get-start-position)] + [end-pos (get-end-position)] + #:start [start-comment ";"] + #:padding [padding ""]) + (begin-edit-sequence) + (define last-pos (last-position)) + (define first-para (position-paragraph start-pos)) + (define last-para (calc-last-para end-pos)) + (for ([curr-para (in-range first-para (+ last-para 1))]) + (define commented (looks-line-commented curr-para + #:start start-comment + #:padding padding)) + (when commented + (delete (car commented) (cdr commented)))) + (end-edit-sequence) + #t) + + (define/public (uncomment-selection/box [start-pos (get-start-position)] + [end-pos (get-end-position)]) (define snip-before (find-snip start-pos 'before-or-none)) (define snip-after (find-snip start-pos 'after-or-none)) (begin-edit-sequence) + (begin0 + (cond + [(and (= start-pos end-pos) + snip-before + (is-a? snip-before comment-box:snip%)) + (extract-contents start-pos snip-before) + #t] + [(and (= start-pos end-pos) + snip-after + (is-a? snip-after comment-box:snip%)) + (extract-contents start-pos snip-after) + #t] + [(and (= (+ start-pos 1) end-pos) + snip-after + (is-a? snip-after comment-box:snip%)) + (extract-contents start-pos snip-after) + #t] + [else #f]) + (end-edit-sequence))) + + (define/public (commented-out/line? [start-pos (get-start-position)] + [end-pos (get-end-position)] + #:start [start-comment ";"] + #:padding [padding ""]) + (define first-para (position-paragraph start-pos)) + (define last-para (calc-last-para end-pos)) + (and (for/or ([curr-para (in-range first-para (+ last-para 1))]) + (looks-line-commented curr-para + #:start start-comment + #:padding padding)) + #t)) + + (define/public (commented-out/region? [start-pos (get-start-position)] + [end-pos (get-end-position)] + #:start [start "#|"] + #:end [end "|#"] + #:continue [continue ""]) + (and (looks-region-commented start-pos end-pos + #:start start + #:end end + #:continue continue + #:padding "") + #t)) + + ;; -> (or/c (cons/c natural? natural?) #f) + ;; if #f, it doesn't look like the paragraph is commented out + ;; if a natural, it does, and the comment start at the result + (define/private (looks-line-commented curr-para + #:start start-comment + #:padding padding) + (define first-on-para + (skip-whitespace (paragraph-start-position curr-para) + 'forward + #f)) + (define last-on-para (paragraph-end-position curr-para)) + (define end-of-potential-comment + (min last-on-para (+ first-on-para (string-length start-comment)))) (cond - [(and (= start-pos end-pos) - snip-before - (is-a? snip-before comment-box:snip%)) - (extract-contents start-pos snip-before)] - [(and (= start-pos end-pos) - snip-after - (is-a? snip-after comment-box:snip%)) - (extract-contents start-pos snip-after)] - [(and (= (+ start-pos 1) end-pos) - snip-after - (is-a? snip-after comment-box:snip%)) - (extract-contents start-pos snip-after)] - [else - (define last-pos (last-position)) - (define first-para (position-paragraph start-pos)) - (define last-para (calc-last-para end-pos)) - (let para-loop ([curr-para first-para]) - (when (<= curr-para last-para) - (define first-on-para - (skip-whitespace (paragraph-start-position curr-para) - 'forward - #f)) - (define last-on-para (paragraph-end-position curr-para)) - (define end-of-potential-comment - (min last-on-para (+ first-on-para (string-length start-comment)))) - (split-snip first-on-para) - (split-snip end-of-potential-comment) - (define all-string-snips? - (let loop ([snip (find-snip first-on-para 'after-or-none)]) - (cond - [snip - (define snip-pos (get-snip-position snip)) - (cond - [(= snip-pos end-of-potential-comment) #t] - [(< snip-pos end-of-potential-comment) - (and (is-a? snip string-snip%) - (loop (send snip next)))] - [else - (error 'racket.rkt::internal-error - "went too far, but did a split-snip first")])] - [else #t]))) - (when (and all-string-snips? - (equal? (get-text first-on-para end-of-potential-comment) - start-comment)) - (delete first-on-para (+ first-on-para (string-length start-comment)))) - (para-loop (add1 curr-para))))]) - (end-edit-sequence) - #t) + [(and (all-string-snips? first-on-para end-of-potential-comment) + (equal? (get-text first-on-para end-of-potential-comment) + start-comment)) + (define end-of-potential-padding + (+ end-of-potential-comment (string-length padding))) + (cond + [(and (<= end-of-potential-padding last-on-para) + (all-string-snips? end-of-potential-comment end-of-potential-padding) + (equal? (get-text end-of-potential-comment end-of-potential-padding) + padding)) + (cons first-on-para end-of-potential-padding)] + [else + (cons first-on-para end-of-potential-comment)])] + [else #f])) + + (define/private (looks-region-commented start-pos end-pos + #:start start + #:end end + #:continue continue + #:padding padding) + (define start-para (position-paragraph start-pos)) + (define end-para (position-paragraph end-pos)) + (define start-comment-pos + (find-string start 'forward + (paragraph-start-position start-para) + (paragraph-end-position start-para))) + (define end-comment-pos + (find-string end 'forward + (paragraph-start-position end-para) + (paragraph-end-position end-para))) + (cond + [(and start-comment-pos end-comment-pos) + (define middles + (for/list ([para (in-range (+ start-para 1) end-para)]) + (define start-pos (paragraph-start-position para)) + (define end-of-padding (+ start-pos (string-length padding))) + (and (not (equal? "" padding)) + (all-string-snips? start-pos end-of-padding) + (equal? (get-text start-pos end-of-padding) padding) + (cons start-pos end-of-padding)))) + (append + (list (cons end-comment-pos (+ end-comment-pos (string-length end)))) + (filter values middles) + (list (cons start-comment-pos (+ start-comment-pos (string-length start)))))] + [else #f])) + + (define/private (all-string-snips? start end) + (split-snip start) + (split-snip end) + (let loop ([snip (find-snip start 'after-or-none)]) + (cond + [snip + (define snip-pos (get-snip-position snip)) + (cond + [(= snip-pos end) #t] + [(< snip-pos end) + (and (is-a? snip string-snip%) + (loop (send snip next)))] + [else + (error 'racket.rkt::internal-error + "went too far, but did a split-snip first")])] + [else #t]))) ;; extract-contents : number (is-a?/c comment-box:snip%) -> void ;; copies the contents of the comment-box-snip out of the snip diff --git a/gui-lib/info.rkt b/gui-lib/info.rkt index 0d04b03f9..43f34a13f 100644 --- a/gui-lib/info.rkt +++ b/gui-lib/info.rkt @@ -34,7 +34,7 @@ (define pkg-authors '(mflatt robby)) -(define version "1.69") +(define version "1.70") (define license '(Apache-2.0 OR MIT)) diff --git a/gui-test/framework/tests/racket.rkt b/gui-test/framework/tests/racket.rkt index 354e23e63..8e939a0ad 100644 --- a/gui-test/framework/tests/racket.rkt +++ b/gui-test/framework/tests/racket.rkt @@ -21,7 +21,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; -;; testing comment-out-selection and uncomment-selection +;; testing comment-out-selection and related methods ;; (define (test-commenting) @@ -49,16 +49,71 @@ (define t (new racket:text%)) (send t insert "ab\ncd") (send t set-position 1 (- (send t last-position) 1)) - (send t comment-out-selection #:start-comment "#") + (send t comment-out-selection #:start "#") (check-equal? (send t get-text) "#ab\n#cd")) (let () (define t (new racket:text%)) (send t insert "ab\ncd") (send t set-position 1 (- (send t last-position) 1)) - (send t comment-out-selection #:start-comment "#" #:padding " ") + (send t comment-out-selection #:start "#" #:padding " ") (check-equal? (send t get-text) "# ab\n# cd")) + (let () + (define t (new racket:text%)) + (send t insert "ab\ncd") + (send t set-position 1 2) + (send t region-comment-out-selection) + (check-equal? (send t get-text) + "a#|b|#\ncd")) + (let () + (define t (new racket:text%)) + (send t insert "ab\ncd") + (send t set-position 1 4) + (send t region-comment-out-selection) + (check-equal? (send t get-text) + "a#|b\nc|#d")) + (let () + (define t (new racket:text%)) + (send t insert "ab\ncd\nef") + (send t set-position 1 7) + (send t region-comment-out-selection) + (check-equal? (send t get-text) + "a#|b\n cd\ne|#f")) + + (let () + (define t (new racket:text%)) + (send t insert " # ab\n ;cd") + (send t set-position 0 (send t last-position)) + (check-equal? (send t commented-out/line? #:start "#") #t) + (check-equal? (send t commented-out/line? #:start ";") #t) + (check-equal? (send t commented-out/line? #:start ";" 0 0) #f) + (check-equal? (send t commented-out/line? #:start ";" + (send t last-position) (send t last-position)) + #t) + (check-equal? (send t commented-out/line? #:start "#" 0 0) #t) + (check-equal? (send t commented-out/line? #:start "#" + (send t last-position) (send t last-position)) + #f)) + + (let () + (define t (new racket:text%)) + (send t insert " #| ab\n c |# d") + (send t set-position 0 (send t last-position)) + (check-equal? (send t commented-out/region?) #t)) + + (let () + (define t (new racket:text%)) + (send t insert " #| ab\n qq\n c |# d") + (send t set-position 0 (send t last-position)) + (check-equal? (send t commented-out/region?) #t)) + + (let () + (define t (new racket:text%)) + (send t insert "a #| |# z") + (send t set-position 0 (send t last-position)) + (check-equal? (send t commented-out/region?) #t)) + (let () (define t (new racket:text%)) (send t insert ";ab\n;cd") @@ -84,21 +139,57 @@ (define t (new racket:text%)) (send t insert "#ab\n#cd") (send t set-position 0 (send t last-position)) - (send t uncomment-selection #:start-comment "#") + (send t uncomment-selection #:start "#") (check-equal? (send t get-text) "ab\ncd")) + (let () (define t (new racket:text%)) (send t insert "##ab\n##cd") (send t set-position 0 (send t last-position)) - (send t uncomment-selection #:start-comment "##") + (send t uncomment-selection #:start "##") (check-equal? (send t get-text) "ab\ncd")) (let () (define t (new racket:text%)) (send t insert " # ab\n #cd") (send t set-position 1 (- (send t last-position) 1)) - (send t uncomment-selection #:start-comment "#") - (check-equal? (send t get-text) " ab\n cd"))) + (send t uncomment-selection #:start "#") + (check-equal? (send t get-text) " ab\n cd")) + + (let () + (define t (new racket:text%)) + (send t insert " # ab\n # cd\n# ef\n#g") + (send t set-position 1 (- (send t last-position) 1)) + (send t uncomment-selection #:start "#" #:padding " ") + (check-equal? (send t get-text) " ab\n cd\nef\ng")) + + (let () + (define t (new racket:text%)) + (send t insert " #| ab\n c |# d") + (send t set-position 0 (send t last-position)) + (send t uncomment-selection/region) + (check-equal? (send t get-text) " ab\n c d")) + + (let () + (define t (new racket:text%)) + (send t insert " #| ab\n qq\n c |# d") + (send t set-position 0 (send t last-position)) + (send t uncomment-selection/region) + (check-equal? (send t get-text) " ab\n qq\n c d")) + + (let () + (define t (new racket:text%)) + (send t insert " #| ab\n qq\n c |# d") + (send t set-position 0 (send t last-position)) + (send t uncomment-selection/region) + (check-equal? (send t get-text) " ab\n qq\n c d")) + + (let () + (define t (new racket:text%)) + (send t insert "a #| |# z") + (send t set-position 0 (send t last-position)) + (send t uncomment-selection/region) + (check-equal? (send t get-text) "a z"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;