Quickscript script to try out classify-position

classify-position-quickscript.rkt

#lang racket/base

;;; 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.

(require quickscript
         racket/format
         racket/class)

;; Like classify position, but gives the class of the character at the insert position,
;; rather than at the next position.
;; For example, in `(define s |"abc")`, where | indicates the position of the cursor,
;; classify-position returns 'string, but classify-insert-position returns 'whitespace.
;; classify-insert-position also returns the kind of comment
;; ('line-comment, 'sexp-comment, or 'nested-comment) instead of just 'comment.
;; If the cursor is at the end of the line in a line-comment, classify-insert-position
;; returns 'line-comment, whereas classify-position returns 'whitespace (due to the next #\newline)
(define (rich-classify-position ed pos)
  (define-values (start end) (send ed get-token-range pos))
  (define class-right (send ed classify-position pos))
  (when (eq? class-right 'comment)
    (define ch (send ed get-character start))
    ; fix comment kind: 'line-comment, 'sexp-comment, or 'nested-comment
    ; RACKET SPECIFIC
    (set! class-right
          (case ch
            [(#\;) 'line-comment]
            [(#\#)
             (define ch2 (send ed get-character (+ start 1))) ; can't fail?
             (case ch2
               [(#\;) 'sexp-comment]
               [(#\|) 'nested-comment] ; not supported yet by the lexer
               [else (error "Unrecognized comment character sequence:" ch ch2)])]
            [else (error "Unrecognized comment character:" ch)])))
  class-right)

(define (classify-position* ed pos)
  (define-values (start end) (send ed get-token-range pos))
  (define class-right (rich-classify-position ed pos))
  (cond
    [(and (> pos 0)
          (= start pos))
     (define class-left (rich-classify-position ed (- pos 1)))
     (list class-left class-right)]
    [else class-right]))

;; Then modify 

(define-script my-classify-position
  #:label "classify&-position"
  #:output-to message-box
  (λ (selection #:editor ed)
    (define pos (send ed get-start-position))
    (define end-pos (send ed get-end-position))
    (define cl (send ed classify-position pos))
    (define cl2 (classify-position* ed pos))
    (~a "cl1: " cl "\ncl2: " cl2 "\nposition: " pos " -> " end-pos)))

(define-script my-tokens
  #:label "to&kens"
  #:output-to message-box
  (λ (selection #:editor ed)
    (define pos (send ed get-start-position))
    (define-values (left right) (send ed get-token-range pos))
    (~a pos "\n" left " " right "\n" (send ed get-lexer))))


;; ------Just for testing------ ;;
;; Also try to place the cursor at the beginning of the file for negative position checks
(define (foo)
  (void "comment" ) ; on a code line
  ; Comment alone on line
  #| Nested #|comment|##|another one|# |#
  (void "nested comment") #|starting on a code line
and ending on a different line|#
  ; at the end of this line, the comment will be badly classified |#
  #;(sexp-comment on one line)
  #;(sexp-comment on
                  multiple
                  lines)
  (void "sexp-comment") #;(on a code line)
  (void "sexp-comment") #;(starting
                           on a code line
                           and ending on another
                           line) (void "with code")
  "two strings""next to each other" ; place the cursor in the middle
  #<<EOS
This is a here-string
EOS
  #f)