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

use 'png for arrow bitmaps, drop redundant with-handlers

Browse Source 
svn: r1083
This commit is contained in:
Matthew Flatt 2005-10-14 14:08:40 +00:00
parent d34597549e
commit e2e6516a84
4 changed files with 38 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/framework/private/frame.ss
View File

@ -2288,10 +2288,8 @@
(with-handlers ([exn:fail:filesystem?
(λ (x) #f)])
(let ([fw (collection-path "framework")])
(with-handlers ([exn:fail:filesystem?
(λ (x) #f)])
(or (directory-exists? (build-path fw ".svn"))
(directory-exists? (build-path fw "CVS"))))))))
(directory-exists? (build-path fw "CVS")))))))
(define bday-click-canvas%
(class canvas%

8
collects/mrlib/syntax-browser.ss
View File

@ -441,10 +441,10 @@ needed to really make this work:
(define (set-box/f! b v) (when (box? b) (set-box! b v)))
(define down-bitmap (include-bitmap (lib "turn-down.png" "icons")))
(define up-bitmap (include-bitmap (lib "turn-up.png" "icons")))
(define down-click-bitmap (include-bitmap (lib "turn-down-click.png" "icons")))
(define up-click-bitmap (include-bitmap (lib "turn-up-click.png" "icons")))
(define down-bitmap (include-bitmap (lib "turn-down.png" "icons") 'png))
(define up-bitmap (include-bitmap (lib "turn-up.png" "icons") 'png))
(define down-click-bitmap (include-bitmap (lib "turn-down-click.png" "icons") 'png))
(define up-click-bitmap (include-bitmap (lib "turn-up-click.png" "icons") 'png))
(define arrow-snip-height
(max 10
(send up-bitmap get-height)

14
collects/setup/setup-unit.ss
View File

@ -527,11 +527,15 @@
(do-install-part 'pre)
(define (make-it desc compile-directory)
(define (make-it desc compile-directory get-namespace)
;; To avoid polluting the compilation with modules that are
;; already loaded, create a fresh namespace before calling
;; this function
;; this function.
;; To avoid keeping modules in memory across collections,
;; pass `make-namespace' as `get-namespace', otherwise use
;; `current-namespace' for `get-namespace'.
(for-each (lambda (cc)
(parameterize ([current-namespace (get-namespace)])
(record-error
cc
(format "Compiling ~a" desc)
@ -552,7 +556,7 @@
compile-directory
(list (cc-path cc) (cc-info cc)))
(setup-printf "No more ~a to compile for ~a"
desc (cc-name cc)))))
desc (cc-name cc))))))
(collect-garbage))
ccs-to-compile))
@ -592,8 +596,8 @@
(when (make-zo)
(with-specified-mode
(lambda ()
(make-it ".zos" compile-directory-zos))))
(when (make-so) (make-it "extensions" compile-directory-extension))
(make-it ".zos" compile-directory-zos make-namespace))))
(when (make-so) (make-it "extensions" compile-directory-extension current-namespace))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Info-Domain Cache ;;