Racket quickscript to join one line to the previous line.

join-previous-line.rkt

#lang racket/base

;; This file is placed in the public domain.

;; Version 1.5 Added testable version. Now add space only when needed. Related bugs fixed.
;; Version 1.4 Remove duplicate source code from gist.
;; Version 1.3 Get characters directly, per suggestion of Laurent O.
;; Version 1.2 Suggestions by Laurent O: help, menu, url2script-info.
;; Version 1.0 Initial release.
;;
;; Style notes: https://groups.google.com/g/racket-users/c/H-EppBmQ7oU
;;

(require racket/class
         quickscript)

(script-help-string "Joins the current line with the previous one.")

(define (char-closing-paren? c)
  (or (char=? c #\))
      (char=? c #\])
      (char=? c #\})))

(define (char-opening-paren? c)
  (or (char=? c #\()
      (char=? c #\[)
      (char=? c #\{)))

;; paren-for-direction? is true if
;; - the character is an open paren and direction is backwards; or
;; - the character is a close paren and direction is forward
(define (paren-for-direction? c delta)
  (or (and (= delta -1)
           (char-opening-paren? c))
      (and (= delta +1)
           (char-closing-paren? c))))

#;(define (find-non-whitespace* ed len delta s)
  (define next1 (+ delta s))
  (cond [(< next1 0) s]
        [(>= s len)  s]
        [(>= next1 len) next1]
        [else
         (define nc (send ed get-character next1))
         (cond
           [(char-whitespace? nc)
            (find-non-whitespace* ed len delta next1)]
           [(> delta 0)
            (values (+ delta s)
                    (paren-for-direction? nc delta))]
           [else (values s
                         (paren-for-direction? nc delta))])]))

(define (find-non-whitespace ed delta s)
  (find-non-whitespace*-testable (lambda (n) (send ed get-character n))
                                 (send ed last-position)
                                 delta
                                 s))

;; could not figure out a simple way to create a text% object to test find-non-whitespace
;; we could pass a getter lambda into find-non-whitespace* so testing would be easier
;; This cloned version is gross, but at least my testing is ok.

;; return: values needs-whitespace-added? 
(define (find-non-whitespace*-testable get-character-fn len delta s)
  (define next1 (+ delta s))
  (cond [(and (< delta 0) (< next1 0))    (values s #false)]
        [(and (< 0 delta) (<= len s))     (values s #false)]         ; s   == len means already at the end
        [(and (< 0 delta) (<= len next1)) (values next1 #false)] ; s+1 == len 
        [else
         (define nc (get-character-fn next1))
         (cond
           [(char-whitespace? nc)
           (find-non-whitespace*-testable get-character-fn len delta next1)]
           [(> delta 0)
            (values (+ delta s)
                    (not (paren-for-direction? nc delta)))]
           [else
            (values s
                    (not (paren-for-direction? nc delta)))])]))

(define (find-non-whitespace-testable str delta start-pos)
  (define (get-character-fn n)
    (string-ref str n))
  (find-non-whitespace*-testable get-character-fn
                                 (string-length str)
                                 delta
                                 start-pos))

(define (join-previous-line-testable str pos)
  ;; you have to provide the starting position. does not move to the start of the line.
  (define s pos)
  (define-values (start-delete start-needs-space?) (find-non-whitespace-testable str -1 s))
  (define-values (end-delete end-needs-space?) (find-non-whitespace-testable str 1 (sub1 s)))

  (string-append (substring str 0 start-delete)
                 (if (and start-needs-space? end-needs-space?) " " "")
                 (substring str end-delete)))
  
(module+ test
  (require test-engine/racket-tests)
  
  ;; this version just returns the position number. for testing only.
  (define (find-non-whitespace-testable1 str delta start-pos)
    (define-values (result-pos paren?)
      (find-non-whitespace-testable str delta start-pos))
    result-pos)
  
  (check-expect (find-non-whitespace-testable1 "x    cat   y" -1 3) 1)
  (check-expect (find-non-whitespace-testable1 "x    cat   y" 1 8) 11)
  (check-expect (find-non-whitespace-testable1 "Hi    cat   y" -1 0) 0)
  (check-expect (find-non-whitespace-testable1 " 3 " -1 1) 0)
  (check-expect (find-non-whitespace-testable1 "   "  1 1) 3)
  (check-expect (find-non-whitespace-testable1 "("  -1 1) 1)
  (check-expect (find-non-whitespace-testable1 "("  1 1) 1)
  (check-expect (find-non-whitespace-testable1 "("  1 -1) 0)
  (check-expect (find-non-whitespace-testable1 "("  -1 0) 0)
  ;; scanning forward: delete whitespace up to closing paren, but
  ;;                   leave the last whitespace if it is not a close paren
  ;; should simplify to - always leave one character of whitespace, possibly by deleting it all here and then inserting it back later
  ;; so that it works with "(good\n\n\nthings)" as well as "(good \n\n\nthings)"
  ;;                                           0         1
  ;;                                           01234567890123
  (check-expect (find-non-whitespace-testable1 "(good things )" 1 5) 6)
  (check-expect (find-non-whitespace-testable1 "(good things )" 1 12) 13)
  
  (check-expect (join-previous-line-testable "" 0) "")
  (check-expect (join-previous-line-testable "(" 0) "(")
  (check-expect (join-previous-line-testable "(" 1) "(")
  (check-expect (join-previous-line-testable "()" 1) "()")
  (check-expect (join-previous-line-testable "(work\n(now))" 5)
                "(work (now))")
  (check-expect (join-previous-line-testable "abc\n\n\n\n\ndef" 6)
                "abc def")
  (check-expect (join-previous-line-testable "abc" 3) "abc")
  (check-expect (join-previous-line-testable "(now     (unhinged))" 4) "(now (unhinged))")
  (check-expect (join-previous-line-testable "(now     (unhinged))" 9) "(now (unhinged))")
  (check-expect (join-previous-line-testable "((do) it\n\n\n )" 10) "((do) it)")
  (check-expect (join-previous-line-testable "(\n\n\nargh)" 3) "(argh)")
  
  (displayln "Good load of test module"))

;; Returns a replacement string for the selected string `selection`
;; ("" if no text is selected), or `#f` to leave the selection as is.
(define-script join-previous-line
  #:label "Join Previous Line"
  #:menu-path ("Re&factor")
  #:shortcut #\6
  #:shortcut-prefix (alt shift)  ;; macos: (cmd shift)
  #:output-to message-box
  (λ (selection #:editor ed)
    (when ed
      (send ed begin-edit-sequence)
      (send ed move-position 'left #f 'line)
      
      (define s (send ed get-start-position))
      
      (define-values (start-delete start-needs-space?) (find-non-whitespace ed -1 s))
      (define-values (end-delete end-needs-space?) (find-non-whitespace ed 1 (sub1 s)))

      (when (<= start-delete end-delete)
        (send ed delete start-delete end-delete)
        ;; the problem is you need to decide if you insert based on whether or not you find a ( or ) to stop
        (when (and start-needs-space? end-needs-space?)
          (send ed insert " " start-delete)))
      
      (send ed end-edit-sequence)
      #f)))

(module url2script-info racket/base
  (provide filename url)
  (define filename "join-lines.rkt")
  (define url "https://gist.github.com/maueroats/4482d93ea4d33332d14e427b491e6f4a"))


(module+ test
  (test))