www

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README

util.rkt (1496B)


      1 #lang racket/base
      2 
      3 (provide read-pre-prompt
      4          read-actual-prompt
      5          skip-newline
      6          peek-read-length
      7          narrow-next-read
      8          peak-until-prompt-length
      9          narrow-until-prompt
     10          silent-prompt-read)
     11 
     12 (require racket/syntax
     13          racket/port)
     14 
     15 (define (read-pre-prompt in)
     16   (regexp-try-match #px"^\\s*" in))
     17 
     18 (define (read-actual-prompt in)
     19   (regexp-try-match #px"^> " in))
     20 
     21 (define (skip-newline in)
     22   (regexp-try-match #px"^\n" in))
     23 
     24 (define (peek-read-length in)
     25   (let* ([pk (peeking-input-port in)]
     26          [start (file-position pk)]
     27          [r (read pk)]
     28          [end (file-position pk)])
     29     (- end start)))
     30 
     31 (define (narrow-next-read in)
     32   (make-limited-input-port in (peek-read-length in)))
     33 
     34 (define (peak-until-prompt-length in)
     35   (let* ([pk (peeking-input-port in)]
     36          [start (file-position pk)]
     37          [end (let loop ()
     38                 (let* ([pre (read-pre-prompt pk)]
     39                        [pos (file-position pk)]
     40                        [pr (read-actual-prompt pk)])
     41                   (if (or pr (eof-object? (read pk)))
     42                       pos
     43                       (loop))))])
     44     (- end start)))
     45 
     46 (define (narrow-until-prompt in)
     47   (make-limited-input-port in (peak-until-prompt-length in)))
     48 
     49 ;; Just like the default `current-prompt-read`, but without showing the prompt.
     50 (define silent-prompt-read
     51   (λ ()
     52     (let ([in ((current-get-interaction-input-port))])
     53       ((current-read-interaction) (object-name in) in))))