Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Send the current s-expression to the interactions window (quickscript)
#lang racket/base
(require quickscript
racket/list
racket/class
framework
racket/gui/base)
;;; Author: Laurent Orseau https://github.com/Metaxal
;;; 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 "Selects the current s-expression or sends it to the interactions")
(define (opening-delimiter? c)
(member c (list #\( #\[ #\{)))
(define (closing-delimiter? c)
(member c (list #\) #\] #\})))
;; TODO: Use classify-position? Requires the tokenizer to be running though
(define (get-user-sexp-range ed start)
(define ranges (send ed get-highlighted-ranges))
; Find the first range for which the cursor is either
(define r1
(for/or ([r (in-list ranges)])
(and (<= (text:range-start r) start (text:range-end r))
r)))
(cond
;; If a sexp is already highlighted by DrRacket,
;; just use that.
[r1
(values (text:range-start r1) (text:range-end r1))]
;; Otherwise we make our own rules about which sexp to use.
[else
(define char-left (if (> start 0)
(send ed get-character (- start 1))
#\nul))
(define char-right (send ed get-character start))
(define left-ws? (char-whitespace? char-left))
(define right-ws? (char-whitespace? char-right))
;; These helpers return the start position pos of the
;; (left, right, up) sexp
;; if there is a sexp at the right of pos.
(define (try-left)
(define pos (send ed get-backward-sexp start))
(and pos (send ed get-forward-sexp pos) pos))
(define (try-right)
(and (send ed get-forward-sexp start) start))
(define (try-up)
(define pos (send ed find-up-sexp start))
(and pos (send ed get-forward-sexp pos) pos))
(define sexp-start
(cond
[(and left-ws? right-ws?)
(or (try-up) (try-right) (try-left))]
[left-ws?
(or (try-right) (try-up) (try-left))]
[right-ws?
(or (try-left) (try-up) (try-right))]
[(opening-delimiter? char-left)
(or (try-right) (try-up) (try-left))]
[(closing-delimiter? char-right)
(or (try-left) (try-up) (try-right))]
[else
(or (try-up) (try-right) (try-left))]))
(define sexp-end (and sexp-start (send ed get-forward-sexp sexp-start)))
(values sexp-start sexp-end)]))
(define-script send-sexp-to-interactions
#:label "Send sexp to interactions"
#:shortcut #\return
#:shortcut-prefix (shift ctl)
(λ (selection #:definitions defs #:editor ed #:interactions ints)
(when (eq? defs ed)
(define start (send ed get-start-position))
(define end (send ed get-end-position))
(define-values (sexp-start sexp-end)
(if (= start end)
(get-user-sexp-range ed start)
(values start end)))
(when sexp-end
(define str (send ed get-text sexp-start sexp-end))
(send ints set-position (send ints last-position))
(send ints insert (string-append str "\n"))
(send ints do-submission) ; submit the expression pending in the interactions
; Trying to give the focus back to the definitinos after an exception, but
; couldn't make it work.
#;(send (send defs get-canvas) focus)))
#f))
(define-script select-user-sexp
#:label "Select user sexp"
#:shortcut #\return
#:shortcut-prefix (ctl)
(λ (selection #:definitions defs #:editor ed)
(when (eq? defs ed)
(define start (send ed get-start-position))
(define end (send ed get-end-position))
(when (= start end)
(define-values (sexp-start sexp-end)
(get-user-sexp-range ed start))
(when sexp-end
(send ed set-position sexp-start sexp-end))))
#f))
(module url2script-info racket/base
(provide filename url)
(define filename "select-or-send-sexp.rkt")
(define url "https://gist.github.com/Metaxal/9f313c17269f9cbcc95f614385309fb8"))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment