Skip to content

Commit

Permalink
tidy up comment/uncomment with an eye towards racket/drracket#634
Browse files Browse the repository at this point in the history 
Specifically:
 - rackety
 - fix docs
 - add tests
 - generalize to abstract over the precise comment string

Some questions remain, specifically what would a #:padding argument to uncomment-selection do?
  • Loading branch information
@rfindler
rfindler committed Sep 10, 2023
1 parent 4653709 commit a35e679
Show file tree
Hide file tree
Showing 3 changed files with 173 additions and 60 deletions.
30 changes: 20 additions & 10 deletions gui-doc/scribblings/framework/racket.scrbl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -152,17 +152,27 @@
of the selection is used.
}

@defmethod*[(((comment-out-selection (start exact-integer?)
(end exact-integer?))
void?))]{
Comments the lines containing positions @racket[start] through @racket[end]
by inserting a semi-colon at the front of each line.
}
@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-selection (start exact-integer?) (end exact-integer?)) void?))]{
Uncomments the lines containing positions @racket[start] through
@racket[end].
}
@defmethod[(uncomment-selection [start exact-integer? (get-start-position)]
[end exact-integer? (get-end-position)]
[#:start-comment start-comment string ";"]) void?]{
Uncomments the paragraphs containing positions
@racket[start] through @racket[end].

Specifically, removes each occurrence of
@racket[start-comment] that appears (potentially following
whitespace) at the start of each paragraph that enclose the
range between @racket[start] and @racket[end].
}

@defmethod*[(((get-forward-sexp (start exact-integer?))
(or/c #f exact-integer?)))]{
Expand Down
121 changes: 71 additions & 50 deletions gui-lib/framework/private/racket.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -703,22 +703,25 @@
last-para)))

(define/public (comment-out-selection [start-pos (get-start-position)]
[end-pos (get-end-position)])
[end-pos (get-end-position)]
#:start-comment [start-comment ";"]
#:padding [padding ""])
(begin-edit-sequence)
(let ([first-pos-is-first-para-pos?
(= (paragraph-start-position (position-paragraph start-pos))
start-pos)])
(let* ([first-para (position-paragraph start-pos)]
[last-para (calc-last-para end-pos)])
(let para-loop ([curr-para first-para])
(when (<= curr-para last-para)
(let ([first-on-para (paragraph-start-position curr-para)])
(insert #\; first-on-para)
(para-loop (add1 curr-para))))))
(when first-pos-is-first-para-pos?
(set-position
(paragraph-start-position (position-paragraph (get-start-position)))
(get-end-position))))
(define first-pos-is-first-para-pos?
(= (paragraph-start-position (position-paragraph start-pos))
start-pos))
(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 (paragraph-start-position curr-para))
(insert padding first-on-para)
(insert start-comment first-on-para)
(para-loop (add1 curr-para))))
(when first-pos-is-first-para-pos?
(set-position
(paragraph-start-position (position-paragraph (get-start-position)))
(get-end-position)))
(end-edit-sequence)
#t)

Expand Down Expand Up @@ -769,41 +772,59 @@
#t)

(define/public (uncomment-selection [start-pos (get-start-position)]
[end-pos (get-end-position)])
(let ([snip-before (find-snip start-pos 'before-or-none)]
[snip-after (find-snip start-pos 'after-or-none)])

(begin-edit-sequence)
(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
(let* ([last-pos (last-position)]
[first-para (position-paragraph start-pos)]
[last-para (calc-last-para end-pos)])
(let para-loop ([curr-para first-para])
(when (<= curr-para last-para)
(let ([first-on-para
(skip-whitespace (paragraph-start-position curr-para)
'forward
#f)])
(split-snip first-on-para)
(when (and (< first-on-para last-pos)
(char=? #\; (get-character first-on-para))
(is-a? (find-snip first-on-para 'after-or-none) string-snip%))
(delete first-on-para (+ first-on-para 1)))
(para-loop (add1 curr-para))))))])
(end-edit-sequence))
[end-pos (get-end-position)]
#:start-comment [start-comment ";"])
(define snip-before (find-snip start-pos 'before-or-none))
(define snip-after (find-snip start-pos 'after-or-none))
(begin-edit-sequence)
(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)

;; extract-contents : number (is-a?/c comment-box:snip%) -> void
Expand Down
82 changes: 82 additions & 0 deletions gui-test/framework/tests/racket.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@

(module+ test
(with-private-prefs
(test-commenting)
(test-get-matching-paren-string)
(open-paren-typing)
(test-text-balanced)
Expand All @@ -18,6 +19,87 @@
(auto-parens-tests)
(ensure-new-racket-mode-parameter-preserves-alt-as-meta-keys)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; testing comment-out-selection and uncomment-selection
;;

(define (test-commenting)

(let ()
(define t (new racket:text%))
(send t comment-out-selection)
(check-equal? (send t get-text) ";"))

(let ()
(define t (new racket:text%))
(send t insert "ab\ncd")
(send t set-position 0 (send t last-position))
(send t comment-out-selection)
(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)
(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 "#")
(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 " ")
(check-equal? (send t get-text) "# ab\n# cd"))

(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)
(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)
(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)
(check-equal? (send t get-text) " ab\n cd"))

(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 "#")
(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 "##")
(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")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; testing get-matching-paren-string method
Expand Down

0 comments on commit a35e679

Please sign in to comment.