Quickscript for sorawee's `fmt`

fmt-quickscript.rkt

#lang racket/base
(require quickscript
         fmt ; needs to be installed first
         racket/class
         racket/set
         racket/list)

;;; Author: Laurent Orseau
;;; License: [Apache License, Version 2.0](http://www.apache.org/licenses/LICENSE-2.0) or
;;;          [MIT license](http://opensource.org/licenses/MIT) at your option.

(script-help-string "Format the selection or the whole program using `fmt`")

(define-logger fmt)

(define space-set (set #\newline #\space #\tab #\ua0))

(define (not-space? x)
  (not (set-member? space-set x)))

(define (idx->shrink-idx str-list)
  (define shrink-idx 0)
  (for/vector ([i (in-string str-list)])
    (begin0 shrink-idx
      (when (not-space? i)
        (set! shrink-idx (add1 shrink-idx))))))

(define (find-conrespond-idx idx old-shrink-idx new-shrink-idx)
  (if (equal? (vector-length old-shrink-idx) idx)
      (add1 (vector-ref new-shrink-idx (sub1 (vector-length new-shrink-idx))))
      (let* ([shrink-idx (vector-ref old-shrink-idx idx)]
             [get-span (lambda (vec)
                         (filter (lambda (x) (equal? shrink-idx (vector-ref vec x)))
                                 (range (vector-length vec))))]
             [old-idx-span (get-span old-shrink-idx)]
             [new-idx-span (get-span new-shrink-idx)])

        (if (empty? new-idx-span)
            (vector-ref new-shrink-idx (sub1 (vector-length new-shrink-idx)))
            (if (equal? shrink-idx (first old-idx-span))
                (vector-ref 0 new-idx-span)
                (last new-idx-span))))))

(define (find-new-position position old new)
  (define old-shrink-idx (idx->shrink-idx old))
  (define new-shrink-idx (idx->shrink-idx new))

  (find-conrespond-idx position old-shrink-idx new-shrink-idx))

(define-script fmt
               #:label "fmt"
               #:menu-path ("Re&factor")
               #:shortcut #\f
               #:shortcut-prefix (ctl)
               (λ (selection #:editor ed #:definitions defs)
                 (cond
                   [(equal? selection "")
                    (define pos (send ed get-end-position))
                    (define txt (send defs get-text))
                    (define new-txt (program-format #:width 102 txt))
                    (define new-position (find-new-position pos txt new-txt))
                    (send defs begin-edit-sequence)
                    (send defs erase)
                    (send defs insert new-txt)
                    (send defs set-position new-position)
                    (send defs end-edit-sequence)
                    #f]
                   [else
                    (program-format #:width 102 selection)
                    #f])))

(module url2script-info racket/base
  (provide filename
           url)
  (define filename "fmt.rkt")
  (define url "https://gist.github.com/luistung/2032cd995dffe8dc28d8506b130ae1ed"))

support keeping position