format-selection.rkt

#lang racket/base
(require quickscript racket/string)

(define prefix-rx #px"^\\s*;+\\s*")
(define fill-column 78)

(define (determine-prefix line)
  (define m (regexp-match prefix-rx line))
  (if m (car m) ""))

(define (strip-prefix line)
  (string-trim (regexp-replace prefix-rx line "")))

(define (fill-paragraph lines prefix limit)
  (define words
    (apply append
           (for/list ([line (in-list lines)])
             (string-split line))))
  (define assembled
    (let loop ([completed '()]
               [current ""]
               [remaining words])
      (if (null? remaining)
          (reverse (cons current completed))
          (let ([next (car remaining)])
            (if (> (+ (string-length current) 1 (string-length next)) limit)
                (loop (cons current completed) "" remaining)
                (loop completed (string-append current next " ") (cdr remaining)))))))
  (define prefixed
    (for/list ([line assembled])
      (string-append prefix line)))
  (string-join prefixed "\n"))

(define (fill text)
  (define lines (string-split text #px"[\r\n]"))
  (define prefix (for/first ([line (in-list lines)]
                             #:when (> (string-length (string-trim line)) 0))
                   (determine-prefix line)))
  (define limit (- fill-column (if prefix (string-length prefix) 0)))
  (define slines (for/list ([line (in-list lines)])
                   (strip-prefix line)))
  (define paragraphs
    (let loop ([result '()]
               [current '()]
               [remaining slines])
      (cond ((null? remaining)
             (reverse (if (null? current)
                          result
                          (cons (reverse current) result))))
            ((= 0 (string-length (car remaining)))
             (if (null? current)
                 (loop result '() (cdr remaining))
                 (loop (cons (reverse current) result) '() (cdr remaining))))
            (#t
             (loop result (cons (car remaining) current) (cdr remaining))))))
  (define filled (for/list ([paragraph (in-list paragraphs)]) (fill-paragraph paragraph prefix limit)))
  (string-append (string-join filled (string-append "\n" prefix "\n")) "\n"))

(define-script format-selection
  #:label "format-selection"
  (λ (selection)
    (fill selection)))

This is a Quickscript for use with DrRacket, which can be used to format comments, as shown in the demo below. This is intended as a demo only and there is no support offered for this script.

This script has a small bug that causes it to hang when a single word is longer than the maximum width (as sometimes happens with long URLs). I forked this and have put a fixed version at https://gist.github.com/zamora/5036b2993f7edf702c5bfed12618c8bf