From 3549e55d5a314451020499c59f6f9612b4c113be Mon Sep 17 00:00:00 2001 From: Kathy Gray Date: Sat, 29 Dec 2007 19:39:25 +0000 Subject: [PATCH] Bringing up to v4 require specs and tool interface. NOTE: testing window is NOT working yet. svn: r8157 --- collects/profj/build-info.ss | 2 +- collects/profj/comb-parsers/parser-units.scm | 82 ++++++++++---------- collects/profj/parser.ss | 2 +- collects/profj/tester.scm | 3 +- collects/profj/tool.ss | 21 ++--- 5 files changed, 57 insertions(+), 53 deletions(-) diff --git a/collects/profj/build-info.ss b/collects/profj/build-info.ss index c517179b90..5a62da8b19 100644 --- a/collects/profj/build-info.ss +++ b/collects/profj/build-info.ss @@ -45,7 +45,7 @@ (htdch-lib? `(lib ,name "htdch" ,@(if scheme? (cdddr path) path))) (scheme-lib? `(lib ,name ,@(cddr path))) - ((and local? (not (to-file))) name) + ((and local? (not (to-file))) `(quote ,name)) (else `(file ,(path->string (build-path dir name))))))) (make-name (lambda () (let ((n (if scheme? (java-name->scheme name) name))) diff --git a/collects/profj/comb-parsers/parser-units.scm b/collects/profj/comb-parsers/parser-units.scm index 813ea249b7..65ad10310d 100644 --- a/collects/profj/comb-parsers/parser-units.scm +++ b/collects/profj/comb-parsers/parser-units.scm @@ -22,47 +22,47 @@ (define (output-map x) #;(!!! (printf "in output-map ~a~n" x)) - (!!! (when (position-token? x) - (set! x (position-token-token x)))) - (!!! (case (token-name x) - [(PIPE) "|"] - [(OR) "||"] - [(OREQUAL) "|="] - [(EQUAL) "="] - [(GT) ">"] - [(LT) "<"] - [(LTEQ) "<="] - [(GTEQ) ">="] - [(PLUS) "+"] - [(MINUS) "-"] - [(TIMES) "*"] - [(DIVIDE) "/"] - [(^T) "^"] - [(O_PAREN) "("] - [(C_PAREN) ")"] - [(O_BRACE) "{"] - [(C_BRACE) "}"] - [(O_BRACKET) "["] - [(C_BRACKET) "]"] - [(SEMI_COLON) ";"] - [(PERIOD) "."] - [(COMMA) ","] - [(NULL_LIT) "null"] - [(TRUE_LIT) "true"] - [(FALSE_LIT) "false"] - [(EOF) "end of input"] - [(caseT) "case"] - [(doT) "do"] - [(elseT) "else"] - [(ifT) "if"] - [(voidT) "void"] - [(STRING_LIT) (format "\"~a\"" (token-value x))] - [(CHAR_LIT) (format "'~a'" (token-value x))] - [(INTEGER_LIT LONG_LIT FLOAT_LIT DOUBLE_LIT - HEX_LIT OCT_LIT HEXL_LIT OCTL_LIT) (token-value x)] - [(IDENTIFIER) (format "identifier ~a" (token-value x))] - [(STRING_ERROR) (format "misformatted string ~a" (token-value x))] - [else (token-name x)]))) + (! (when (position-token? x) + (set! x (position-token-token x)))) + (! (case (token-name x) + [(PIPE) "|"] + [(OR) "||"] + [(OREQUAL) "|="] + [(EQUAL) "="] + [(GT) ">"] + [(LT) "<"] + [(LTEQ) "<="] + [(GTEQ) ">="] + [(PLUS) "+"] + [(MINUS) "-"] + [(TIMES) "*"] + [(DIVIDE) "/"] + [(^T) "^"] + [(O_PAREN) "("] + [(C_PAREN) ")"] + [(O_BRACE) "{"] + [(C_BRACE) "}"] + [(O_BRACKET) "["] + [(C_BRACKET) "]"] + [(SEMI_COLON) ";"] + [(PERIOD) "."] + [(COMMA) ","] + [(NULL_LIT) "null"] + [(TRUE_LIT) "true"] + [(FALSE_LIT) "false"] + [(EOF) "end of input"] + [(caseT) "case"] + [(doT) "do"] + [(elseT) "else"] + [(ifT) "if"] + [(voidT) "void"] + [(STRING_LIT) (format "\"~a\"" (token-value x))] + [(CHAR_LIT) (format "'~a'" (token-value x))] + [(INTEGER_LIT LONG_LIT FLOAT_LIT DOUBLE_LIT + HEX_LIT OCT_LIT HEXL_LIT OCTL_LIT) (token-value x)] + [(IDENTIFIER) (format "identifier ~a" (token-value x))] + [(STRING_ERROR) (format "misformatted string ~a" (token-value x))] + [else (token-name x)]))) (define (java-keyword? t) (memq t `(? this super new instanceof while try throw synchronized switch return ifT goto for finally diff --git a/collects/profj/parser.ss b/collects/profj/parser.ss index 8adbdcc168..a021879440 100644 --- a/collects/profj/parser.ss +++ b/collects/profj/parser.ss @@ -1,4 +1,4 @@ -#cs + (module parser mzscheme (require "parsers/full-parser.ss" "parsers/advanced-parser.ss" diff --git a/collects/profj/tester.scm b/collects/profj/tester.scm index 4b99321991..23031bf625 100644 --- a/collects/profj/tester.scm +++ b/collects/profj/tester.scm @@ -192,6 +192,7 @@ (init-field (current-tab #f)) (define/public (pop-up-window test-results) + (when (and drscheme-frame current-tab) (let* ((curr-win (send current-tab get-test-window)) (window (if curr-win @@ -217,7 +218,7 @@ (if (get-preference 'profj:test-window:docked? (lambda () (put-preferences '(profj:test-window:docked?) '(#f)) #f)) (send drscheme-frame display-test-panel content) - (send window show #t)))) + (send window show #t))))) (define/private (fill-in editor test-results) (let-values (((tested-classes covered nearly-tested-classes total-tests diff --git a/collects/profj/tool.ss b/collects/profj/tool.ss index e9790db905..1d7faef30c 100644 --- a/collects/profj/tool.ss +++ b/collects/profj/tool.ss @@ -596,7 +596,7 @@ (let ((end? (eof-object? (peek-char-or-special port)))) (if end? eof - (datum->syntax #f `(parse-java-full-program ,(parse port name level) + (datum->syntax #f `(parse-java-full-program ,(parse port (quote name) level) ,name) #f))))))) (define/public (front-end/interaction port settings) (mred? #t) @@ -769,7 +769,7 @@ (syntax-case exp (parse-java-full-program parse-java-interactions) ((parse-java-full-program ex s) (let ((exp (old-current-eval (syntax ex))) - (src (old-current-eval (syntax s)))) + (src (old-current-eval (syntax (quote s))))) (execution? #t) (set! execute-types (create-type-record)) (let* ((compilation-units (compile-ast exp level execute-types)) @@ -825,7 +825,7 @@ (require? (old-current-eval (syntax-as-top (with-syntax ([name name-to-require]) - (syntax (require name))))) + (syntax (require (quote name)))))) (loop mods extras #f)) (else (let-values (((name syn) (get-module-name (expand (car mods))))) @@ -1031,12 +1031,14 @@ (define (java-comment-box-mixin %) (class % - (inherit get-special-menu get-edit-target-object register-capability-menu-item) + (inherit + get-insert-menu + get-special-menu get-edit-target-object register-capability-menu-item) (super-new) (new menu-item% (label (string-constant profj-insert-java-comment-box)) - (parent (get-special-menu)) + (parent (get-insert-menu)) (callback (lambda (menu event) (let ([c-box (new java-comment-box%)] @@ -1046,7 +1048,7 @@ (demand-callback (lambda (mi) (send mi enable ((get-edit-target-object) . is-a? . text%))))) - (register-capability-menu-item 'profj:special:java-comment-box (get-special-menu)) + (register-capability-menu-item 'profj:special:java-comment-box (get-insert-menu)) )) (drscheme:get/extend:extend-unit-frame java-comment-box-mixin) @@ -1134,19 +1136,20 @@ (define (java-interactions-box-mixin %) (class % - (inherit get-special-menu get-edit-target-object register-capability-menu-item) + (inherit get-insert-menu + get-special-menu get-edit-target-object register-capability-menu-item) (super-new) (new menu-item% (label (string-constant profj-insert-java-interactions-box)) - (parent (get-special-menu)) + (parent (get-insert-menu)) (callback (lambda (menu event) (let ([i-box (new java-interactions-box%)] [text (get-edit-target-object)]) (send text insert i-box) (send text set-caret-owner i-box 'global))))) - (register-capability-menu-item 'profj:special:java-interactions-box (get-special-menu)) + (register-capability-menu-item 'profj:special:java-interactions-box (get-insert-menu)) )) (drscheme:get/extend:extend-definitions-text defs-text-mixin)