misc improvements around read-language (uses and docs)
- make a logger for drracket-related #lang problems - change read-language's docs to indicate that it can return #f - adjust a bunch of calls to read-language for the case that it returns #f with the goal of making that be the same as a get-info function that always returns the given default - mention `read-language` in the guide section entitled "Source-Handling Configuration"
This commit is contained in:
Robby Findler
parent
017480c9b9
commit
8429f3e9d6
|
|
@ -60,9 +60,10 @@
|
|||
(or (looks-like-new-module-style? text)
|
||||
(looks-like-old-module-style? text)
|
||||
(with-handlers ((exn:fail? (λ (x) #f)))
|
||||
(procedure?
|
||||
(begin
|
||||
(read-language (open-input-text-editor text 0 'end (λ (x) x) text #f)
|
||||
(λ () #f))))))
|
||||
(λ () #f))
|
||||
#t))))
|
||||
|
||||
(: looks-like-old-module-style? ((Instance Text%) -> Boolean))
|
||||
(define (looks-like-old-module-style? text)
|
||||
|
|
|
|||
|
|
@ -1483,7 +1483,8 @@
|
|||
(define prt (open-input-text-editor definitions-text))
|
||||
(port-count-lines! prt)
|
||||
(define l (with-handlers ((exn:fail? (λ (x) #f)))
|
||||
(read-language prt)))
|
||||
(read-language prt)
|
||||
#t))
|
||||
(cond
|
||||
[l
|
||||
(define-values (line col pos) (port-next-location prt))
|
||||
|
|
|
|||
|
|
@ -104,6 +104,8 @@
|
|||
(when (send defs get-in-module-language?)
|
||||
(send defs move-to-new-language))))))
|
||||
|
||||
(define-logger drracket-language)
|
||||
|
||||
(define definitions-text-mixin
|
||||
(mixin (text:basic<%>
|
||||
drracket:unit:definitions-text<%>
|
||||
|
|
@ -168,27 +170,31 @@
|
|||
(clear-things-out)])))
|
||||
|
||||
(define/public (move-to-new-language)
|
||||
(let* ([port (open-input-text-editor this)]
|
||||
(define port (open-input-text-editor this))
|
||||
|
||||
(define (fallback)
|
||||
;; fall back to whatever #lang racket does if
|
||||
;; we don't have a #lang line present in the file
|
||||
(log-drracket-language-debug "falling back to using #lang racket's read-language for ~a"
|
||||
(or (send this get-filename) "<<unsaved file>>"))
|
||||
(vector (read-language (open-input-string "#lang racket"))))
|
||||
|
||||
;; info-result :
|
||||
;; (or/c #f [#lang without a known language]
|
||||
;; (vector <get-info-proc>)
|
||||
;; [no #lang line, so we use the '#lang racket' info proc]
|
||||
;; <get-info-proc>) [the get-info proc for the program in the definitions]
|
||||
[info-result
|
||||
(define info-result
|
||||
(with-handlers ([exn:fail?
|
||||
(λ (x)
|
||||
(log-debug
|
||||
(log-drracket-language-debug
|
||||
(format
|
||||
"DrRacket: error duing call to read-language for ~a:\n ~a"
|
||||
(or (send this get-filename) "<<unsaved file>>")
|
||||
(regexp-replace* #rx"\n(.)" (exn-message x) "\n\\1 ")))
|
||||
#f)])
|
||||
(read-language
|
||||
port
|
||||
(lambda ()
|
||||
;; fall back to whatever #lang racket does if
|
||||
;; we don't have a #lang line present in the file
|
||||
(vector (read-language (open-input-string "#lang racket"))))))])
|
||||
(or (read-language port fallback)
|
||||
(fallback))))
|
||||
|
||||
; sometimes I get eof here, but I don't know why and can't seem to
|
||||
;; make it happen outside of DrRacket
|
||||
|
|
@ -201,7 +207,7 @@
|
|||
(let ([s (send this get-text)])
|
||||
(substring s 0 (min 100 (string-length s)))))
|
||||
(set! info-result #f))
|
||||
(let-values ([(line col pos) (port-next-location port)])
|
||||
(define-values (line col pos) (port-next-location port))
|
||||
(unless (equal? (get-text 0 pos) hash-lang-language)
|
||||
(set! hash-lang-language (get-text 0 pos))
|
||||
(set! hash-lang-last-location pos)
|
||||
|
|
@ -255,7 +261,7 @@
|
|||
(ctc-on-info-proc-result
|
||||
(or/c #f (listof symbol?))
|
||||
(or (info-proc 'drracket:opt-out-toolbar-buttons '())
|
||||
(info-proc 'drscheme:opt-out-toolbar-buttons '())))))))))
|
||||
(info-proc 'drscheme:opt-out-toolbar-buttons '())))))))
|
||||
|
||||
|
||||
(define/private (register-new-buttons buttons opt-out-ids)
|
||||
|
|
|
|||
|
|
@ -244,7 +244,10 @@ as the @racket[_key] argument to the @racket[_get-info] function to do so:
|
|||
@item{@language-info-ref[color-lexer]}]
|
||||
|
||||
If the call to @racket[read-language] raises an error, DrRacket logs the
|
||||
error via @racket[log-debug].
|
||||
error at the @racket[_debug] level to a logger with the name
|
||||
@racket['drracket-language] (see
|
||||
@secref["logging" #:doc '(lib "scribblings/reference/reference.scrbl")] for more
|
||||
about how to follow specific loggers).
|
||||
|
||||
@language-info-def[color-lexer]{
|
||||
When a language's @racket[_get-info] procedure responds to @racket['color-lexer], it
|
||||
|
|
|
|||
|
|
@ -312,7 +312,8 @@ racket
|
|||
|
||||
This revised @racket[literal] implementation provides a
|
||||
@racketidfont{get-info} function. The @racketidfont{get-info} function
|
||||
will be applied to the source input stream and location information,
|
||||
is called by @racket[read-language] (which DrRacket calls) with the
|
||||
source input stream and location information,
|
||||
in case query results should depend on the content of the module after
|
||||
the language name (which is not the case for @racket[literal]). The
|
||||
result of @racketidfont{get-info} is a function of two arguments. The
|
||||
|
|
|
|||
|
|
@ -107,7 +107,7 @@ See @secref["readtables"] for an extended example that uses
|
|||
|
||||
@defproc[(read-language [in input-port? (current-input-port)]
|
||||
[fail-thunk (-> any) (lambda () (error ...))])
|
||||
(any/c any/c . -> . any)]{
|
||||
(or/c (any/c any/c . -> . any) #f)]{
|
||||
|
||||
Reads from @racket[in] in the same way as @racket[read], but stopping as
|
||||
soon as a @tech{reader language} (or its absence) is determined.
|
||||
|
|
@ -125,12 +125,13 @@ or @litchar{#!}.
|
|||
When it finds a @litchar{#lang} or @litchar{#!} specification, instead
|
||||
of dispatching to a @racketidfont{read} or @racketidfont{read-syntax}
|
||||
function as @racket[read] and @racket[read-syntax] do,
|
||||
@racket[read-language] dispatches to a @racketidfont{get-info}
|
||||
@racket[read-language] dispatches to the @racketidfont{get-info}
|
||||
function (if any) exported by the same module. The result of the
|
||||
@racketidfont{get-info} function is the result of
|
||||
@racket[read-language] if it is a function of two arguments; if
|
||||
@racketidfont{get-info} produces any other kind of result, the
|
||||
@exnraise[exn:fail:contract].
|
||||
@exnraise[exn:fail:contract]. If no @racketidfont{get-info} function is
|
||||
exported, @racket[read-language] returns @racket[#f].
|
||||
|
||||
The function produced by @racketidfont{get-info} reflects information
|
||||
about the expected syntax of the input stream. The first argument to the
|
||||
|
|
|
|||
|
|
@ -54,7 +54,9 @@ to delegate to the scheme-lexer (in the 'no-lang-line mode).
|
|||
(set-port-next-location-from in p)
|
||||
(set-port-next-location-from in name-p)
|
||||
(define-values (_1 _2 start-pos) (port-next-location p))
|
||||
(define get-info (with-handlers ([exn:fail? values]) (read-language p (λ () 'fail))))
|
||||
(define get-info (with-handlers ([exn:fail? values])
|
||||
(or (read-language p (λ () 'fail))
|
||||
(λ (x y) y))))
|
||||
(define-values (_3 _4 end-pos) (port-next-location p))
|
||||
(cond
|
||||
[(procedure? get-info)
|
||||
|
|
|
|||
|
|
@ -1978,7 +1978,7 @@
|
|||
[read-syntax (->opt [Univ -Input-Port] (Un (-Syntax Univ) (-val eof)))]
|
||||
[read/recursive (->opt [-Input-Port (-opt -Char) (-opt -Read-Table) Univ] Univ)]
|
||||
[read-syntax/recursive (->opt [Univ -Input-Port (-opt -Char) (-opt -Read-Table) Univ] Univ)]
|
||||
[read-language (->opt [-Input-Port (-> ManyUniv)] (-> Univ Univ ManyUniv))]
|
||||
[read-language (->opt [-Input-Port (-> ManyUniv)] (-opt (-> Univ Univ ManyUniv)))]
|
||||
|
||||
[read-case-sensitive (-Param Univ B)]
|
||||
[read-square-bracket-as-paren (-Param Univ B)]
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user