suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

Allow the last expresion of the lang-line to span multiple lines. Stop providing #%top-interaction, so that one from the user's language is used instead (still can't access the bindings without providing them + (require (submod .)), but it's a step forward)

Browse Source
This commit is contained in:
Georges Dupéron 2017-05-11 23:38:46 +02:00
parent a0e807ce43
commit d0a3a0b255
5 changed files with 56 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lang.rkt
View File

@ -5,4 +5,4 @@
(provide (rename-out [module-begin/doc #%module-begin])
;; TODO: this is the #%top-interaction from racket/base, not from the
;; user-specified language.
#%top-interaction)
#;#%top-interaction)

35
lang/first-line-utils.rkt
View File

@ -18,12 +18,35 @@
(make-limited-input-port port (read-line-length port)))
(define (read-*-whole-first-line rec-read in)
(define in1 (narrow-to-one-line in))
(let loop ([res '()])
(define res+ (rec-read in1))
(if (eof-object? res+)
(reverse res)
(loop (cons res+ res)))))
(define in1 (peeking-input-port (narrow-to-one-line in)))
(define start-pos (file-position in1))
(let loop ([last-good-pos start-pos])
(define res+
;; Try to read (may fail if the last object to read spills onto the next
;; lines. We read from the peeking-input-port, so that we can retry the
;; last read on the full, non-narrowed port.
(with-handlers ([exn:fail:read? (λ (_) 'read-error)])
(list (rec-read in1))))
(cond
[(eq? res+ 'read-error)
;; Last read was unsuccessful, only consume the bytes from the original
;; input port up to the last successful read. Then, re-try one last read
;; on the whole file (i.e. the last read object may span several lines).
(read-bytes (- last-good-pos start-pos) in)
(list (rec-read in))]
[(eof-object? (car res+))
;; Last successful read, actually consume the bytes from the original
;; input port. Technically, last-good-pos and (file-position pk) should
;; be the same, since the last read returned #<eof> (and therefore did
;; not advance the read pointer.
(read-bytes (- (file-position in1) start-pos) in)
'()]
[else
;; One successful read. Prepend it, and continue reading some more.
(cons (car res+)
(loop (file-position in1)))])))
(define (read-whole-first-line in)
(read-*-whole-first-line (λ (in1) (read in1)) in))

24
lang/reader.rkt
View File

@ -38,14 +38,23 @@ hyper-literate/lang
(make-scribble-inside-lexer #:command-char (or command-char #\@)))
(define (read/options in offset x-mode)
(define-values (line column position) (port-next-location in))
(define-values (mode2 command-char)
(define-values (mode2 command-char depth)
(apply values x-mode))
(define-values (txt type paren start end) (racket-lexer in))
(define-values (txt type paren start end status) (racket-lexer/status in))
(define new-depth (case status
[(open) (add1 depth)]
[(close) (sub1 depth)]
[else depth]))
;; TODO: limit the number of newlines to a single newline.
(if (and (eq? type 'white-space)
(regexp-match #px"\n" txt))
(if (or
;; Fallback to scribble mode fast if we get a close-paren too many.
;; This could be because the text starts right after the last "config"
;; expression (which would start on the first line, then continue).
(< new-depth 0)
(and (= new-depth 0)
(and (eq? type 'white-space)
(regexp-match #px"\n" txt))))
(values txt type paren start end
0 (list 'main (make-lexr command-char) command-char #f))
(let ()
@ -61,16 +70,15 @@ hyper-literate/lang
#\@))
#\@))))
(values txt type paren start end
0 (list 'options new-command-char)))))
0 (list 'options new-command-char new-depth)))))
(lambda (key defval default)
(case key
[(color-lexer)
(λ (in offset x-mode)
(define-values (line column position) (port-next-location in))
(cond
[(eq? x-mode #f)
(read/options in offset (list 'options #f))]
(read/options in offset (list 'options #f 0))]
[(eq? (car x-mode) 'options)
(read/options in offset x-mode)]
[else

3
private/common.rkt
View File

@ -179,8 +179,7 @@
[(_modbeg {~or (lang:id
{~optional (~and no-require-lang #:no-require-lang)}
{~optional (~and no-auto-require #:no-auto-require)})
({~optional (~and no-require-lang #:no-require-lang)}
{~optional (~and no-auto-require #:no-auto-require)}
({~optional (~and no-auto-require #:no-auto-require)}
(lang:id
. chain₊))}
body0 . body)

13
private/lp.rkt
View File

@ -128,6 +128,9 @@
;; TODO: hash tables
[else e]))
(define-for-syntax (prettify-chunk-name str)
(regexp-replace #px"^<(.*)>$" str "«\\1»"))
(define-for-syntax ((make-chunk-display racketblock unsyntax-id) stx)
(syntax-parse stx
;; no need for more error checking, using chunk for the code will do that
@ -145,6 +148,7 @@
(define n-repeat (get+increment-repeat-chunk-number!
original-name:n))
(define str (symbol->string (syntax-e #'name)))
(define str-display (prettify-chunk-name str))
(define/with-syntax tag (format "chunk:~a:~a:~a" str n n-repeat))
(define/with-syntax (rest ...)
;; if the would-be-next number for this chunk name is "2", then there is
@ -178,11 +182,12 @@
(list (elemtag '(prefixable tag)
(bold (italic (elemref '(prefixable tag)
#:underline? #f
#,str rest ...))
#,str-display rest ...))
" ::=")))
(list (smaller
(make-link-element "plainlink"
(decode-content (list #,str rest ...))
(decode-content
(list #,str-display rest ...))
`(elem (prefixable
,@(chunks-toc-prefix)
tag))))))
@ -274,8 +279,8 @@
[(_ id)
(identifier? #'id)
(with-syntax ([tag (format "chunk:~a:1:1" (syntax-e #'id))]
[str (format "~a" (syntax-e #'id))])
#'(elemref '(prefixable tag) #:underline? #f str))]))
[pretty (prettify-chunk-name (format "~a" (syntax-e #'id)))])
#'(elemref '(prefixable tag) #:underline? #f pretty))]))
(provide (all-from-out scheme/base