suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Correction to testing display (respects font preferences now). Adding order to the choice of composite module

Browse Source 
svn: r4389
This commit is contained in:
Kathy Gray 2006-09-19 21:01:05 +00:00
parent de53685ae2
commit 8411780c8b
3 changed files with 18 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/profj/display-java.ss
View File

@ -2,6 +2,7 @@
(require (lib "class.ss")
(lib "mred.ss" "mred")
(lib "framework.ss" "framework")
(lib "Object.ss" "profj" "libs" "java" "lang")
(lib "String.ss" "profj" "libs" "java" "lang")
(lib "array.ss" "profj" "libs" "java" "lang"))
@ -144,7 +145,7 @@
(define (make-java-snip value style)
(let* ((formatted-java (format-java-value value style))
(editor (new text%))
(editor (new (editor:standard-style-list-mixin text%)))
(snip (new editor-snip% (editor editor)
(with-border? #f))))
(when (> (total-length formatted-java) 28)

18
collects/profj/tester.scm
View File

@ -197,7 +197,7 @@
(if curr-win
curr-win
(make-object test-window%)))
(content (make-object text%)))
(content (make-object (editor:standard-style-list-mixin text%))))
(fill-in content test-results)
(send content lock #t)
(send window update-editor content)
@ -250,7 +250,7 @@
(send editor insert "\n"))
(if (testcase-ext?)
(send editor insert "Run the following tests:\n")
(send editor insert "Ran the following tests:\n")
(send editor insert "Tested the following Example classes:\n"))
(for-each
(lambda (test-info)
@ -446,7 +446,11 @@
;make-link: text% (listof (U string snip%)) src -> void
(define (make-link text msg dest)
(for-each (lambda (m) (send text insert m)) msg)
(for-each (lambda (m)
(when (is-a? m snip%)
(send m set-style (send (send text get-style-list)
find-named-style "Standard")))
(send text insert m)) msg)
(let ((start (send text get-end-position)))
(send text insert (format-src dest))
(send text set-clickback
@ -460,8 +464,7 @@
(send text change-style (make-object style-delta% 'change-underline #t)
start end #f)
(send c set-delta-foreground "royalblue")
(send text change-style c start end #f))
))
(send text change-style c start end #f))))
(define (open-and-highlight-in-file srcloc)
(let* ([position (src-pos srcloc)]
@ -477,10 +480,13 @@
(define (make-covered-button covered dest partial?)
(send dest insert " ")
(let* ((editor (new text%))
(let* ((editor (new (editor:standard-style-list-mixin text%)
[auto-wrap #t]))
(snip (new editor-snip% (editor editor)
(with-border? #t)))
(start (send dest get-end-position)))
(send snip set-style
(send (send dest get-style-list) find-named-style "Standard"))
(if partial?
(send editor insert "Show covered expressions")
(send editor insert "Show all covered expressions"))

7
collects/profj/to-scheme.ss
View File

@ -341,13 +341,14 @@
(member (id-string (name-id extend))
(map id-string (map def-name ordered-defs)))))
;make-composite-name: def -> string
;make-composite-name: string -> string
(define (make-composite-name d)
(build-identifier (string-append (id-string (header-id (def-header d))) "-composite")))
(build-identifier (string-append d "-composite")))
;translate-defs: (list def) type-records -> (values (list syntax) (list reqs))
(define (translate-defs defs type-recs)
(module-name (make-composite-name (car defs)))
(let ((sorted-d-list (sort (map (compose id-string def-name) defs) string<?)))
(module-name (make-composite-name (car sorted-d-list))))
(module-require (if (to-file)
(let ((location (build-path (begin (send type-recs set-location! (def-file (car defs)))
(send type-recs get-compilation-location) "compiled")