From cc2c701a7dc618882ac0464e4e3c6bcd2e3c34a0 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 17 Jul 2012 06:19:15 -0600 Subject: [PATCH] racket/gui/init: make load handler chain to original For a non-WXME file, fall back to the original load handler, instead of re-implementing it. This makes module caching work the right way. Falling back to the original means closing the port and then re-opening the file to load, but that seems ok. --- collects/mred/private/snipfile.rkt | 139 ++++++++++++++++------------- 1 file changed, 79 insertions(+), 60 deletions(-) diff --git a/collects/mred/private/snipfile.rkt b/collects/mred/private/snipfile.rkt index 11903906df..f763ea6099 100644 --- a/collects/mred/private/snipfile.rkt +++ b/collects/mred/private/snipfile.rkt @@ -241,58 +241,75 @@ ;; don't load the file from source or reload useless bytecode: (void)]))) + (define original-load-handler (current-load)) + (define (text-editor-load-handler filename expected-module) (unless (path? filename) - (raise-type-error 'text-editor-load-handler "path" filename)) - (let-values ([(in-port src) (build-input-port filename)]) - (dynamic-wind - (lambda () (void)) - (lambda () - (parameterize ([read-accept-compiled #t] - [read-accept-reader #t] - [read-accept-lang #t] - [read-on-demand-source (and (load-on-demand-enabled) - (path->complete-path filename))]) - (if expected-module - (with-module-reading-parameterization - (lambda () - (jump-to-submodule - in-port - expected-module - (lambda (check-second?) - (with-module-reading-parameterization - (lambda () - (let* ([first (read-syntax src in-port)] - [module-ized-exp (check-module-form first expected-module filename)] - [second (if check-second? - (read in-port) - eof)]) - (unless (eof-object? second) - (raise-syntax-error - 'text-editor-load-handler - (format "expected only a `module' declaration for `~s', but found an extra expression" - expected-module) - second)) - (eval module-ized-exp)))))))) - (let loop ([last-time-values (list (void))]) - (let ([exp (read-syntax src in-port)]) - (if (eof-object? exp) - (apply values last-time-values) - (call-with-values (lambda () (call-with-continuation-prompt - (lambda () (eval - (datum->syntax - #f - (cons '#%top-interaction exp) - exp))) - (default-continuation-prompt-tag) - (lambda args - (apply - abort-current-continuation - (default-continuation-prompt-tag) - args)))) - (lambda x (loop x))))))))) - (lambda () - (close-input-port in-port))))) + (raise-argument-error 'text-editor-load-handler "path?" filename)) + (unless (or (not expected-module) + (symbol? expected-module) + (and (pair? expected-module) + (list? expected-module) + (pair? (cdr expected-module)) + (or (not (car expected-module)) + (symbol? (car expected-module))) + (andmap symbol? (cdr expected-module)))) + (raise-argument-error 'text-editor-load-handler + "(or/c #f symbol? (cons/c (or/c #f symbol?) (non-empty-listof symbol?)))" + expected-module)) + (let-values ([(in-port src wxme?) (build-input-port filename)]) + (if wxme? + (dynamic-wind + (lambda () (void)) + (lambda () + (parameterize ([read-accept-compiled #t] + [read-accept-reader #t] + [read-accept-lang #t] + [read-on-demand-source (and (load-on-demand-enabled) + (path->complete-path filename))]) + (if expected-module + (with-module-reading-parameterization + (lambda () + (jump-to-submodule + in-port + expected-module + (lambda (check-second?) + (with-module-reading-parameterization + (lambda () + (let* ([first (read-syntax src in-port)] + [module-ized-exp (check-module-form first expected-module filename)] + [second (if check-second? + (read in-port) + eof)]) + (unless (eof-object? second) + (raise-syntax-error + 'text-editor-load-handler + (format "expected only a `module' declaration for `~s', but found an extra expression" + expected-module) + second)) + (eval module-ized-exp)))))))) + (let loop ([last-time-values (list (void))]) + (let ([exp (read-syntax src in-port)]) + (if (eof-object? exp) + (apply values last-time-values) + (call-with-values (lambda () (call-with-continuation-prompt + (lambda () (eval + (datum->syntax + #f + (cons '#%top-interaction exp) + exp))) + (default-continuation-prompt-tag) + (lambda args + (apply + abort-current-continuation + (default-continuation-prompt-tag) + args)))) + (lambda x (loop x))))))))) + (lambda () + (close-input-port in-port))) + (begin + (close-input-port in-port) + (original-load-handler filename expected-module))))) ;; build-input-port : string -> (values input any) @@ -301,18 +318,20 @@ (define (build-input-port filename) (let ([p (open-input-file filename)]) (port-count-lines! p) - (let ([p (cond - [(regexp-match-peek #rx#"^(?:#reader[(]lib\"read[.]ss\"\"wxme\"[)])?WXME01[0-9][0-9] ##[ \r\n]" p) - (let ([t (make-object text%)]) - (send t insert-port p 'standard) - (close-input-port p) - (open-input-text-editor t 0 'end values filename))] - [else p])]) - (port-count-lines! p) ; in case it's new - (values p filename)))) + (define-values (new-p changed?) + (cond + [(regexp-match-peek #rx#"^(?:#reader[(]lib\"read[.]ss\"\"wxme\"[)])?WXME01[0-9][0-9] ##[ \r\n]" p) + (let ([t (make-object text%)]) + (send t insert-port p 'standard) + (close-input-port p) + (values (open-input-text-editor t 0 'end values filename) #t))] + [else (values p #f)])) + (when changed? + (port-count-lines! p)) ; in case it's new + (values p filename changed?))) (define (open-input-graphical-file filename) - (let-values ([(p name) (build-input-port filename)]) + (let-values ([(p name wxme?) (build-input-port filename)]) p)) (define open-output-text-editor