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/algol60/parse.ss
View File

@ -190,7 +190,7 @@
[(IF <Boolean-expression> [(IF <Boolean-expression>
THEN <simple-Boolean> THEN <simple-Boolean>
ELSE <Boolean-expression>) ELSE <Boolean-expression>)
(make-a60:if $2 $4 $6)]) (make-a60:if $2 $4 $6)])
;; -------------------- Designationals -------------------- ;; -------------------- Designationals --------------------
(<label> [(<identifier>) $1] (<label> [(<identifier>) $1]
[(<unsigned-integer>) $1]) [(<unsigned-integer>) $1])
@ -204,7 +204,7 @@
[(IF <Boolean-expression> [(IF <Boolean-expression>
THEN <simple-designational-expression> THEN <simple-designational-expression>
ELSE <designational-expression>) ELSE <designational-expression>)
(make-a60:if $2 $4 $6)]) (make-a60:if $2 $4 $6)])
;; -------------------- Variables -------------------- ;; -------------------- Variables --------------------
(<subscript-list> [(<arithmetic-expression>) (list $1)] (<subscript-list> [(<arithmetic-expression>) (list $1)]
[(<subscript-list> COMMA <arithmetic-expression>) (append $1 (list $3))]) [(<subscript-list> COMMA <arithmetic-expression>) (append $1 (list $3))])

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

@ -2288,10 +2288,8 @@
(with-handlers ([exn:fail:filesystem? (with-handlers ([exn:fail:filesystem?
(λ (x) #f)]) (λ (x) #f)])
(let ([fw (collection-path "framework")]) (let ([fw (collection-path "framework")])
(with-handlers ([exn:fail:filesystem? (or (directory-exists? (build-path fw ".svn"))
(λ (x) #f)]) (directory-exists? (build-path fw "CVS")))))))
(or (directory-exists? (build-path fw ".svn"))
(directory-exists? (build-path fw "CVS"))))))))
(define bday-click-canvas% (define bday-click-canvas%
(class 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 (set-box/f! b v) (when (box? b) (set-box! b v)))
(define down-bitmap (include-bitmap (lib "turn-down.png" "icons"))) (define down-bitmap (include-bitmap (lib "turn-down.png" "icons") 'png))
(define up-bitmap (include-bitmap (lib "turn-up.png" "icons"))) (define up-bitmap (include-bitmap (lib "turn-up.png" "icons") 'png))
(define down-click-bitmap (include-bitmap (lib "turn-down-click.png" "icons"))) (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"))) (define up-click-bitmap (include-bitmap (lib "turn-up-click.png" "icons") 'png))
(define arrow-snip-height (define arrow-snip-height
(max 10 (max 10
(send up-bitmap get-height) (send up-bitmap get-height)

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

@ -526,33 +526,37 @@
ccs-to-compile))) ccs-to-compile)))
(do-install-part 'pre) (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 ;; To avoid polluting the compilation with modules that are
;; already loaded, create a fresh namespace before calling ;; 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) (for-each (lambda (cc)
(record-error (parameterize ([current-namespace (get-namespace)])
cc (record-error
(format "Compiling ~a" desc) cc
(lambda () (format "Compiling ~a" desc)
(unless (control-io-apply (lambda ()
(case-lambda (unless (control-io-apply
[(p) (case-lambda
;; Main "doing something" message [(p)
(setup-fprintf p "Compiling ~a used by ~a" ;; Main "doing something" message
desc (cc-name cc))] (setup-fprintf p "Compiling ~a used by ~a"
[(p where) desc (cc-name cc))]
;; Doing something specifically in "where" [(p where)
(setup-fprintf p " in ~a" ;; Doing something specifically in "where"
(path->string (setup-fprintf p " in ~a"
(path->complete-path (path->string
where (path->complete-path
(cc-path cc))))]) where
compile-directory (cc-path cc))))])
(list (cc-path cc) (cc-info cc))) compile-directory
(setup-printf "No more ~a to compile for ~a" (list (cc-path cc) (cc-info cc)))
desc (cc-name cc))))) (setup-printf "No more ~a to compile for ~a"
desc (cc-name cc))))))
(collect-garbage)) (collect-garbage))
ccs-to-compile)) ccs-to-compile))
@ -592,8 +596,8 @@
(when (make-zo) (when (make-zo)
(with-specified-mode (with-specified-mode
(lambda () (lambda ()
(make-it ".zos" compile-directory-zos)))) (make-it ".zos" compile-directory-zos make-namespace))))
(when (make-so) (make-it "extensions" compile-directory-extension)) (when (make-so) (make-it "extensions" compile-directory-extension current-namespace))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Info-Domain Cache ;; ;; Info-Domain Cache ;;