Racket quickscript emulation of Emacs' `just-one-space`

just-one-space.rkt

#lang racket/base

;; This file is placed in the public domain.

(require racket/class ; need for `(send ed ...)`?
         quickscript
         tests/eli-tester)

;; light emulation of emacs' `just-one-space`

;; limitations:
;;
;; * doesn't handle anything other than spaces (so not tabs, etc.)
;; * doesn't do the prefix argument thing, but is that practical
;;   in drracket anyway?

;; find first non-space character to the left of `position` in `line-str`
(define (find-left-bound position line-str)
  (let loop ([curr-pos position])
    (when (positive? curr-pos)
      (define left-char-str
        (substring line-str (sub1 curr-pos) curr-pos))
      (if (string=? left-char-str " ")
          (loop (sub1 curr-pos))
          curr-pos))))

(test

  (find-left-bound 7 "hello    fellow sentients!")
  =>
  5
 
  )

;; find first non-space character to the right of `position` in `line-str`
(define (find-right-bound position line-str)
  (define line-end-pos (sub1 (string-length line-str)))
  (let loop ([curr-pos position])
    (when (< curr-pos line-end-pos)
      (define right-char-str
        (substring line-str curr-pos (add1 curr-pos)))
      (if (string=? right-char-str " ")
          (loop (add1 curr-pos))
          curr-pos))))

(test

  (find-right-bound 8 "hello      fellow non-sentients!")
  =>
  11

  )

(define-script just-one-space
  #:label "Just one space"
  #:shortcut #\space
  #:shortcut-prefix (alt)
  (λ (_ #:editor ed)
    (define start-pos (send ed get-start-position))
    (define end-pos (send ed get-end-position))
    ;; only operate when selection empty -- possibly unneeded check
    (when (= start-pos end-pos)
      ;; XXX: are `(send ed begin-edit-sequence)` and `(send ed end-edit-sequence)` needed?
      ;; needed to determine line-str and curr-pos
      (define curr-line
        (send ed position-line end-pos))
      (define line-start-pos
        (send ed line-start-position curr-line))
      (define line-end-pos
        (send ed line-end-position curr-line))
      ;; actually needed values
      (define line-str
        (send ed get-text line-start-pos line-end-pos))
      (define curr-pos
        (- end-pos line-start-pos))
      ;; left bound
      (define left-result
        (+ line-start-pos (find-left-bound curr-pos line-str)))
      ;; right bound
      (define right-result
        (+ line-start-pos (find-right-bound curr-pos line-str)))
      ;; collapse spaces around current cursor position, though
      ;; if there are no spaces around, insert a space
      (send ed delete left-result right-result)
      (send ed insert " "))))

(module url2script-info racket/base
  (provide filename url)
  (define filename "just-one-space.rkt")
  (define url "https://gist.github.com/sogaiu/4a33ab18ef707fba9f60367bd767d9bb"))