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>
THEN <simple-Boolean>
ELSE <Boolean-expression>)
(make-a60:if $2 $4 $6)])
(make-a60:if $2 $4 $6)])
;; -------------------- Designationals --------------------
(<label> [(<identifier>) $1]
[(<unsigned-integer>) $1])
@ -204,7 +204,7 @@
[(IF <Boolean-expression>
THEN <simple-designational-expression>
ELSE <designational-expression>)
(make-a60:if $2 $4 $6)])
(make-a60:if $2 $4 $6)])
;; -------------------- Variables --------------------
(<subscript-list> [(<arithmetic-expression>) (list $1)]
[(<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?
(λ (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"))))))))
(or (directory-exists? (build-path fw ".svn"))
(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)

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

@ -526,33 +526,37 @@
ccs-to-compile)))
(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)
(record-error
cc
(format "Compiling ~a" desc)
(lambda ()
(unless (control-io-apply
(case-lambda
[(p)
;; Main "doing something" message
(setup-fprintf p "Compiling ~a used by ~a"
desc (cc-name cc))]
[(p where)
;; Doing something specifically in "where"
(setup-fprintf p " in ~a"
(path->string
(path->complete-path
where
(cc-path cc))))])
compile-directory
(list (cc-path cc) (cc-info cc)))
(setup-printf "No more ~a to compile for ~a"
desc (cc-name cc)))))
(parameterize ([current-namespace (get-namespace)])
(record-error
cc
(format "Compiling ~a" desc)
(lambda ()
(unless (control-io-apply
(case-lambda
[(p)
;; Main "doing something" message
(setup-fprintf p "Compiling ~a used by ~a"
desc (cc-name cc))]
[(p where)
;; Doing something specifically in "where"
(setup-fprintf p " in ~a"
(path->string
(path->complete-path
where
(cc-path cc))))])
compile-directory
(list (cc-path cc) (cc-info cc)))
(setup-printf "No more ~a to compile for ~a"
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 ;;