Added semaphores for futures

collects/2htdp/image.rkt

@@ -11,7 +11,7 @@ method returns #f, then you get a black circle out.
 improvments/changes wrt to htdp/image:
 
   - copying and pasting does not introduce jaggies
-  - equal comparisions are more efficient
+  - equal comparisons are more efficient
   - added rotation & scaling
   - got rid of pinholes (see the new overlay, beside, and above functions)
   - a bunch of new polygon functions

collects/2htdp/private/image-more.rkt

@@ -382,9 +382,8 @@
 (define/chk (place-image/align image1 x1 y1 x-place y-place image2)
   (when (or (eq? x-place 'pinhole) (eq? y-place 'pinhole))
     (check-dependencies 'place-image/align
-                        (and (send image1 get-pinhole)
+                        (send image1 get-pinhole)
-                             (send image2 get-pinhole))
+                        "when x-place or y-place is ~e or ~e, the the first image argument must have a pinhole"
-                        "when x-place or y-place is ~e or ~e, then both of the image arguments must have pinholes"
                         'pinhole "pinhole"))
   (place-image/internal image1 x1 y1 image2 x-place y-place))
 

collects/2htdp/tests/image-equality-performance-htdp.rkt

@@ -411,7 +411,7 @@ Also added the timing code at the end.
 
 
 ;;purpose :given the board ,square to be played,column and row label and returns a new board 
-;;with the square to be  played at the position reffered
+;;with the square to be  played at the position referred
 ;; play-on-board : board square symbol symbol -> board
 
 ;;test

collects/2htdp/tests/image-equality-performance.rkt

@@ -416,7 +416,7 @@ Also added the timing code at the end.
 
 
 ;;purpose :given the board ,square to be played,column and row label and returns a new board 
-;;with the square to be  played at the position reffered
+;;with the square to be  played at the position referred
 ;; play-on-board : board square symbol symbol -> board
 
 ;;test

collects/2htdp/tests/record-stop-when.rkt

@@ -3,12 +3,10 @@
 (require 2htdp/universe 2htdp/image (only-in lang/imageeq image=?))
 
 (define (draw-number n)
-  (place-image (text (number->string n) 44 'red)
+  (place-image (text (number->string n) 44 'red) 50 50 (empty-scene 100 100)))
-               50 50
-               (empty-scene 100 100)))
 
 (define (draw-stop n)
-  stop)
+  (place-image stop 50 50 (empty-scene 100 100)))
 (define stop (text "STOP" 44 'red))
 
 
@@ -28,7 +26,7 @@
             (on-draw draw-number)
             (record? dir)))
 (sleep 1)
-(unless (image=? (bitmap "images0/i1.png") (draw-number 0))
+(unless (image=? (bitmap "images0/i1.png") (draw-stop 5))
   (fprintf (current-error-port)
-           "this test needs to be revised -- image=? doesn't work\n"))
+           "this test needs to be revised -- the way 'world' writes images adds an extra pixel -- think! \n"))
 

collects/2htdp/tests/test-image.rkt

@@ -1891,6 +1891,17 @@
        0 0 "center" "center"
        (rectangle 10 100 'solid 'blue)))
 
+(test (clear-pinhole
+       (place-image/align
+        (center-pinhole (rectangle 100 10 'solid 'red))
+        0 0 "pinhole" "pinhole"
+        (rectangle 10 100 'solid 'blue)))
+      =>
+      (place-image/align
+       (rectangle 100 10 'solid 'red)
+       0 0 "center" "center"
+       (rectangle 10 100 'solid 'blue)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;;  test errors.
@@ -2030,18 +2041,7 @@
           =>
           #rx"^underlay/align")
 
-(test/exn (place-image/align
+
-           (center-pinhole (rectangle 10 100 'solid 'blue))
-           0 0 "pinhole" "center"
-           (rectangle 100 10 'solid 'red))
-          =>
-          #rx"^place-image/align")
-(test/exn (place-image/align
-           (center-pinhole (rectangle 10 100 'solid 'blue))
-           0 0 "center" "pinhole" 
-           (rectangle 100 10 'solid 'red))
-          =>
-          #rx"^place-image/align")
 (test/exn (place-image/align
            (rectangle 100 10 'solid 'red)
            0 0 "pinhole" "center"
@@ -2203,7 +2203,7 @@
     (let loop ([obj obj])
       (when (struct? obj)
         (let ([stuff (vector->list (struct->vector obj))])
-          (unless (member (car stuff) '(struct:flip struct:translate struct:scale)) ;; skip these becuase normalization eliminates them
+          (unless (member (car stuff) '(struct:flip struct:translate struct:scale)) ;; skip these because normalization eliminates them
             (hash-set! counts (car stuff) (+ 1 (hash-ref counts (car stuff) 0))))
           (for-each loop (cdr stuff)))))
     (sort (hash-map counts list) string<=? #:key (λ (x) (symbol->string (car x))))))

collects/2htdp/uchat/chatter.rkt

@@ -20,7 +20,7 @@
  +------------------------------------------------------------------+
 
  Convention: the names of participants may not contain ":". 
- The first typed ":" separates the addressess from the message.
+ The first typed ":" separates the addresses from the message.
  
  TODO:
    -- the editing of too-tall send messages is a bit off screen. 

collects/algol60/cfg-parser.rkt

@@ -627,7 +627,7 @@
 								  l))))
 						  pats (caddr old-list))))
 				     nt-ids patss)
-				    ;; Build a definiton for each non-term:
+				    ;; Build a definition for each non-term:
 				    (loop (cdr clauses)
 					  cfg-start
 					  (map (lambda (nt pats handles $ctxs)

collects/combinator-parser/private-combinator/errors.scm

@@ -95,7 +95,7 @@
                   name curr-id message-to-date))]
                [(sub-seq choice)
                 (fail-type->message (sequence-fail-found fail-type)
-                                    (add-to-message (msg (format "An error occured in ~a.\n" id-name))
+                                    (add-to-message (msg (format "An error occurred in ~a.\n" id-name))
                                                     name (sequence-fail-id fail-type) message-to-date))]
                [(options)
                 (let ([sorted-opts (sort (options-fail-opts (sequence-fail-found fail-type))
@@ -138,7 +138,7 @@
                                      [else msg])])
                           (collapse-message
                            (add-to-message 
-                            (msg (format "An error occured in the ~a. Possible errors were: \n ~a"
+                            (msg (format "An error occurred in the ~a. Possible errors were: \n ~a"
                                          name 
                                          (alternate-error-list (map err-msg messages))))
                             name #f message-to-date)))]))]
@@ -172,7 +172,7 @@
                       (equal? top-names no-dup-names))
                  (collapse-message 
                   (add-to-message
-                   (msg (format "An error occured in this ~a; expected ~a instead."
+                   (msg (format "An error occurred in this ~a; expected ~a instead."
                                 name (nice-list no-dup-names)))
                    name #f message-to-date))]
                 [(and (<= (choice-fail-options fail-type) max-choice-depth)
@@ -184,13 +184,13 @@
                       (collapse-message
                        (add-to-message (car messages) #f #f
                                        (add-to-message
-                                        (msg (format "An error occured in this ~a, expected ~a instead."
+                                        (msg (format "An error occurred in this ~a, expected ~a instead."
                                                      name (nice-list no-dup-names)))
                                         name #f message-to-date)))]
                      [else
                       (collapse-message 
                        (add-to-message
-                        (msg (format "An error occured in this ~a; expected ~a instead. Possible errors were:\n~a"
+                        (msg (format "An error occurred in this ~a; expected ~a instead. Possible errors were:\n~a"
                                      name (nice-list no-dup-names) 
                                      (alternate-error-list (map err-msg messages))))
                         name #f message-to-date))]))]
@@ -198,7 +198,7 @@
                       (> (length winners) 1))
                  (collapse-message 
                   (add-to-message
-                   (msg (format "An error occured in this ~a. Possible options include ~a.\n"
+                   (msg (format "An error occurred in this ~a. Possible options include ~a.\n"
                                 name (nice-list 
                                       (first-n max-choice-depth no-dup-names))))
                    name #f message-to-date))]
@@ -206,7 +206,7 @@
                  (fail-type->message
                   (car winners)
                   (add-to-message
-                   (msg (format "An error occured in this ~a~a.~a\n"
+                   (msg (format "An error occurred in this ~a~a.~a\n"
                                 name 
                                 (if (equal? name top-name) "" (format ", it is possible you intended ~a ~a here"
                                                                       (a/an top-name) top-name))

collects/compiler/embed-unit.rkt

@@ -16,7 +16,8 @@
 	   "private/macfw.ss"
 	   "private/mach-o.ss"
 	   "private/windlldir.ss"
-	   "private/collects-path.ss")
+	   "private/collects-path.ss"
+           "find-exe.rkt")
   
   (provide compiler:embed@)
   
@@ -61,47 +62,6 @@
                         (path-replace-suffix name #"")))
           dest))
     
-    ;; Find executable relative to the "mzlib"
-    ;; collection.
-    (define (find-exe mred? variant)
-      (let* ([base (if mred?
-                       (find-gui-bin-dir)
-                       (find-console-bin-dir))]
-             [fail
-              (lambda ()
-                (error 'create-embedding-executable
-                       "can't find ~a executable for variant ~a"
-                       (if mred? "GRacket" "Racket")
-                       variant))])
-        (let ([exe (build-path
-                    base
-                    (case (system-type)
-                      [(macosx)
-                       (cond
-                         [(not mred?)
-                          ;; Need Racket:
-                          (string-append "racket" (variant-suffix variant #f))]
-                         [mred?
-                          ;; Need GRacket:
-                          (let ([sfx (variant-suffix variant #t)])
-                            (build-path (format "GRacket~a.app" sfx)
-                                        "Contents" "MacOS" 
-                                        (format "GRacket~a" sfx)))])]
-                      [(windows)
-                       (format "~a~a.exe" (if mred?
-                                              "Gracket"
-                                              "Racket")
-                               (variant-suffix variant #t))]
-                      [(unix)
-                       (format "~a~a" (if mred?
-                                          "gracket"
-                                          "racket")
-                               (variant-suffix variant #f))]))])
-          (unless (or (file-exists? exe)
-                      (directory-exists? exe))
-            (fail))
-          exe)))
-    
     (define exe-suffix?
       (delay (equal? #"i386-cygwin" (path->bytes (system-library-subpath)))))
     
@@ -623,7 +583,7 @@
                                [(name)
                                 ;; a notification; if the name matches one of our special names,
                                 ;; assume that it's from a namespace that has the declaration
-                                ;; [it would be better if the noritifer told us the source]
+                                ;; [it would be better if the notifier told us the source]
                                 (let-values ([(name) (if name (resolved-module-path-name name) #f)])
                                   (let-values ([(a) (assq name mapping-table)])
                                     (if a

collects/compiler/find-exe.rkt

@@ -0,0 +1,45 @@
+#lang racket/base
+(require setup/dirs
+         setup/variant)
+(provide find-exe)
+
+;; Find executable relative to the "mzlib"
+;; collection.
+(define (find-exe mred? [variant (system-type 'gc)])
+  (let* ([base (if mred?
+                   (find-gui-bin-dir)
+                   (find-console-bin-dir))]
+         [fail
+          (lambda ()
+            (error 'find-exe
+                   "can't find ~a executable for variant ~a"
+                   (if mred? "GRacket" "Racket")
+                   variant))])
+    (let ([exe (build-path
+                base
+                (case (system-type)
+                  [(macosx)
+                   (cond
+                     [(not mred?)
+                      ;; Need Racket:
+                      (string-append "racket" (variant-suffix variant #f))]
+                     [mred?
+                      ;; Need GRacket:
+                      (let ([sfx (variant-suffix variant #t)])
+                        (build-path (format "GRacket~a.app" sfx)
+                                    "Contents" "MacOS" 
+                                    (format "GRacket~a" sfx)))])]
+                  [(windows)
+                   (format "~a~a.exe" (if mred?
+                                          "Gracket"
+                                          "Racket")
+                           (variant-suffix variant #t))]
+                  [(unix)
+                   (format "~a~a" (if mred?
+                                      "gracket"
+                                      "racket")
+                           (variant-suffix variant #f))]))])
+      (unless (or (file-exists? exe)
+                  (directory-exists? exe))
+        (fail))
+      exe)))

collects/compiler/private/vmphase.rkt

@@ -803,7 +803,7 @@
 		 ;; distinguish between tail & non-tail calls
 		 ;; implement tail calls to "simple" primitives a regular calls
 		 ;; no need to pass anything to tail here because it's already
-		 ;;  a tail value if its a tail-apply
+		 ;;  a tail value if it's a tail-apply
 		 ;; the vm-optimizer will refine the multi-ness of this application,
 		 ;;  and worry about inter & intra-vehicle calls
 		 ;;

collects/drracket/drracket.rkt

@@ -4,12 +4,14 @@
 (define debugging? (getenv "PLTDRDEBUG"))
 (define profiling? (getenv "PLTDRPROFILE"))
 
+(define first-parallel? (getenv "PLTDRPAR"))
+
 (define install-cm? (and (not debugging?)
                          (getenv "PLTDRCM")))
 
 (define cm-trace? (or (equal? (getenv "PLTDRCM") "trace")
-                      (equal? (getenv "PLTDRDEBUG") "trace")))
+                      (equal? (getenv "PLTDRDEBUG") "trace")
-
+                      (equal? (getenv "PLTDRPAR") "trace")))
 
 ;; the flush is only here to ensure that the output is 
 ;; appears when running in cygwin under windows.
@@ -17,40 +19,7 @@
   (apply printf fmt args)
   (flush-output))
 
-(when debugging?
+(define (run-trace-thread)
-  (flprintf "PLTDRDEBUG: installing CM to load/create errortrace zos\n")
-  (let-values ([(zo-compile
-                 make-compilation-manager-load/use-compiled-handler
-                 manager-trace-handler)
-                (parameterize ([current-namespace (make-base-empty-namespace)]
-                               [use-compiled-file-paths '()])
-                  (values
-                   (dynamic-require 'errortrace/zo-compile 'zo-compile)
-                   (dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler)
-                   (dynamic-require 'compiler/cm 'manager-trace-handler)))])
-    (current-compile zo-compile)
-    (use-compiled-file-paths (list (build-path "compiled" "errortrace")))
-    (current-load/use-compiled (make-compilation-manager-load/use-compiled-handler))
-    (error-display-handler (dynamic-require 'errortrace/errortrace-lib
-                                            'errortrace-error-display-handler))
-    (when cm-trace?
-      (flprintf "PLTDRDEBUG: enabling CM tracing\n")
-      (manager-trace-handler
-       (λ (x) 
-         (when (regexp-match #rx"compiling:|end compile:" x)
-           (display "1: ") (display x) (newline) (flush-output)))))))
-
-(when install-cm?
-  (flprintf "PLTDRCM: installing compilation manager\n")
-  (let-values ([(make-compilation-manager-load/use-compiled-handler
-                 manager-trace-handler)
-                (parameterize ([current-namespace (make-base-empty-namespace)])
-                  (values
-                   (dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler)
-                   (dynamic-require 'compiler/cm 'manager-trace-handler)))])
-    (current-load/use-compiled (make-compilation-manager-load/use-compiled-handler))
-    (when cm-trace?
-      (flprintf "PLTDRCM: enabling CM tracing\n")
   (let ([evt (make-log-receiver (current-logger) 'info)])
     (void
      (thread
@@ -61,7 +30,75 @@
           (when (regexp-match #rx"^cm: *compil(ing|ed)" str)
             (display str)
             (newline))
-              (loop)))))))))
+          (loop)))))))
+
+(cond
+  [debugging?
+   (flprintf "PLTDRDEBUG: loading CM to load/create errortrace zos\n")
+   (let-values ([(zo-compile
+                  make-compilation-manager-load/use-compiled-handler
+                  manager-trace-handler)
+                 (parameterize ([current-namespace (make-base-empty-namespace)]
+                                [use-compiled-file-paths '()])
+                   (values
+                    (dynamic-require 'errortrace/zo-compile 'zo-compile)
+                    (dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler)
+                    (dynamic-require 'compiler/cm 'manager-trace-handler)))])
+     (flprintf "PLTDRDEBUG: installing CM to load/create errortrace zos\n")
+     (current-compile zo-compile)
+     (use-compiled-file-paths (list (build-path "compiled" "errortrace")))
+     (current-load/use-compiled (make-compilation-manager-load/use-compiled-handler))
+     (error-display-handler (dynamic-require 'errortrace/errortrace-lib
+                                             'errortrace-error-display-handler))
+     (when cm-trace?
+       (flprintf "PLTDRDEBUG: enabling CM tracing\n")
+       (run-trace-thread)))]
+  [install-cm?
+   (flprintf "PLTDRCM: loading compilation manager\n")
+   (let-values ([(make-compilation-manager-load/use-compiled-handler
+                  manager-trace-handler)
+                 (parameterize ([current-namespace (make-base-empty-namespace)])
+                   (values
+                    (dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler)
+                    (dynamic-require 'compiler/cm 'manager-trace-handler)))])
+     (flprintf "PLTDRCM: installing compilation manager\n")
+     (current-load/use-compiled (make-compilation-manager-load/use-compiled-handler))
+     (when cm-trace?
+       (flprintf "PLTDRCM: enabling CM tracing\n")
+       (run-trace-thread)))]
+  [first-parallel?
+   (flprintf "PLTDRPAR: loading compilation manager\n")
+   (define (files-in-coll coll)
+     (define dir (collection-path coll))
+     (map (λ (x) (build-path dir x)) 
+          (filter
+           (λ (x) (regexp-match #rx"rkt$" (path->string x)))
+           (directory-list dir))))
+   (define-values (make-compilation-manager-load/use-compiled-handler manager-trace-handler)
+     (parameterize ([current-namespace (make-base-empty-namespace)])
+       (values
+        (dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler)
+        (dynamic-require 'compiler/cm 'manager-trace-handler))))
+   (when cm-trace?
+     (flprintf "PLTDRPAR: enabling CM tracing\n")
+     (run-trace-thread))
+   (flprintf "PLTDRPAR: loading setup/parallel-build\n")
+   (define parallel-compile-files
+     (parameterize ([current-load/use-compiled (make-compilation-manager-load/use-compiled-handler)])
+       (dynamic-require 'setup/parallel-build 'parallel-compile-files)))
+   (flprintf "PLTDRPAR: parallel compile of framework & drracket\n")
+   (parallel-compile-files (append (files-in-coll "drracket") (files-in-coll "framework"))
+                           #:handler
+                           (λ (handler-type path msg out err)
+                             (case handler-type
+                               [(done) (void)]
+                               [else
+                                (printf "msg: ~s\n" msg)
+                                (printf "stdout from compiling ~a:\n~a\n" path out)
+                                (flush-output)
+                                (fprintf (current-error-port) "stderr from compiling ~a:\n~a\n" path err)])))
+   (flprintf "PLTDRPAR: installing compilation manager\n")
+   (current-load/use-compiled (make-compilation-manager-load/use-compiled-handler))])
 
 (when profiling?
   (flprintf "PLTDRPROFILE: installing profiler\n")

collects/drracket/private/debug.rkt

@@ -472,6 +472,8 @@ profile todo:
         [(pair? cms) (list (car cms))]
         [else '()])))
   
+  ;; show-syntax-error-context : 
+  ;; display the source information associated with a syntax error (if present)
   (define (show-syntax-error-context port exn)
     (let ([error-text-style-delta (make-object style-delta%)]
           [send-out

collects/drracket/private/module-language-tools.rkt

@@ -100,7 +100,9 @@
               (unless timer
                 (set! timer (new timer% 
                                  [notify-callback
-                                  (λ () (move-to-new-language))]
+                                  (λ () 
+                                    (when in-module-language?
+                                      (move-to-new-language)))]
                                  [just-once? #t])))
               (send timer stop)
               (send timer start 200 #t)))))

collects/drracket/private/module-language.rkt

@@ -121,7 +121,7 @@
                   ;; newlines can break things (ie the language text won't 
                   ;; be in the right place in the interactions window, which
                   ;; at least makes the test suites unhappy), so get rid of 
-                  ;; them from the name. Otherwise, if there is some wierd formatting,
+                  ;; them from the name. Otherwise, if there is some weird formatting,
                   ;; so be it.
                   (regexp-replace* #rx"[\r\n]+"
                                    (substring str (cdr (car pos)) (string-length str))

collects/drracket/private/syncheck-debug.rkt

@@ -124,7 +124,7 @@
          (send f show #t))]))
   
   ;; build-ht : stx -> hash-table
-  ;; the resulting hash-table maps from the each sub-object's to it's syntax.
+  ;; the resulting hash-table maps from the each sub-object's to its syntax.
   (define (syntax-object->datum/ht stx)
     (let ([ht (make-hash-table)])
       (values (let loop ([stx stx])

collects/drracket/private/syncheck/contract-traversal.rkt

@@ -200,7 +200,7 @@
        (loop (car val))
        (loop (cdr val))])))
 
-;; returns #t if the result is known to be a predicate that shoudl correspond to a
+;; returns #t if the result is known to be a predicate that should correspond to a
 ;; complete obligation for the contract. If it is some unknown variable, this variable
 ;; may refer to some other contract with nested obligations, so we have to return #f here.
 ;; approximate this by just asking 'did this identifier come from the core?' (which is known

collects/drracket/private/unit.rkt

@@ -451,7 +451,7 @@ module browser threading seems wrong.
         (values get-program-editor-mixin
                 add-to-program-editor-mixin)))
     
-    ;; this sends a message to it's frame when it gets the focus
+    ;; this sends a message to its frame when it gets the focus
     (define make-searchable-canvas%
       (λ (%)
         (class %

collects/dynext/dynext.scrbl

@@ -294,7 +294,7 @@ A parameter that indicates the target for linking, where
 @defproc[(use-standard-linker (name (one-of/c 'cc 'gcc 'msvc 'borland 'cw)))
          void?]{
 
-Sets the parameters decribed in @secref["link-params"] for a
+Sets the parameters described in @secref["link-params"] for a
 particular known linker.}
 
 

collects/embedded-gui/doc.txt

@@ -257,7 +257,7 @@ alignment<%>.
 
 _stretchable-editor-snip-mixin_ gives an editor snip the
 _stretchable-snip<%>_ interface allowing it to be stretched
-to fit it's alignment-parent<%>'s alloted width. Stretchable
+to fit its alignment-parent<%>'s alloted width. Stretchable
 snips are useful as the snip of a snip-wrapper%.
 
 _stretchable-editor-snip%_ is (stretcable-editor-snip-mixin editor-snip%)
@@ -292,7 +292,7 @@ interface and gives it key bindings to tab ahead and back.
 
 The _set-tabbing_ function sets the tabbing order of
 tabbable-text<%>s by setting each text's set-ahead and
-set-back thunks to point to it's neighbor in the argument
+set-back thunks to point to its neighbor in the argument
 list.
 
 > (set-tabbing a-text ...)

collects/embedded-gui/private/alignment.rkt

@@ -1,19 +1,19 @@
 #|
-This code computes the sizes for the rectangles in the space using the on dimention
+This code computes the sizes for the rectangles in the space using the on dimension
-off dimention method of referencing sizes. This means for example instead of saying
+off dimension method of referencing sizes. This means for example instead of saying
-width we say off dimention for vertical alignment. Inorder to consume and return
+width we say off dimension for vertical alignment. Inorder to consume and return
 the values in terms of width and height manipulation had to be done. I chose to create
 a struct abs-rect (abstract rectangle) and have code map horizontal and vertical rect
 stucts on to them. This code is a bit long but more readable than the other two options
 I came up with.
   1) define all functions to be letrec bound functions inside align. align then take
-     accessors for the rect struct. The caller of align swaps the order of ondimention
+     accessors for the rect struct. The caller of align swaps the order of ondimension
-     and off dimention accessors for vertical or horizontal code. This method does not
+     and off dimension accessors for vertical or horizontal code. This method does not
      allow the use of the readable, short, consis pattern matching code. As some of the
      matching code is easily removed this may be a good option but a large letrec
      is harder to write tests for.
   2) define a pattern matcher syntax that will match the struct rect but swap the fields
-     based on wich on is the on or off dimention. This would have been shorter but much
+     based on which on is the on or off dimension. This would have been shorter but much
      more confusing.
 The current implementation requires align to map over the rects and allocate new stucts
 for each one on both passing into and returning from stretch-to-fit; This is not a bottle
@@ -138,7 +138,7 @@ neck and it is the most readable solution.
                    (loop rest-rects (+ onpos onsize))))]))))
   
   #;(natural-number? . -> . (-> (union 1 0)))
-  ;; makes a thunk that returns 1 for it's first n applications, zero otherwise
+  ;; makes a thunk that returns 1 for its first n applications, zero otherwise
   (define (waner n)
     (lambda ()
       (if (zero? n)

collects/embedded-gui/scribblings/embedded-gui.scrbl

@@ -81,7 +81,7 @@ t   hat are labeled from a particular set of strings.}
 
 Sets the tabbing order of @scheme[tabbable-text<%>]s by setting each
 text's @method[tabbable-text<%> set-ahead] and
-@method[tabbable-text<%> set-back] thunks to point to it's neighbor in
+@method[tabbable-text<%> set-back] thunks to point to its neighbor in
 the argument list.}
 
 

collects/ffi/examples/magick.rkt

@@ -60,7 +60,7 @@
          [(DrawingWand?   w) DrawGetException         ]
          [else (error 'raise-wand-exception "got an unknown value: ~e" w)])
    w)
-  (error 'wand-exception "an undefined error occured with ~e" w))
+  (error 'wand-exception "an undefined error occurred with ~e" w))
 
 (define-fun-syntax _status
   (syntax-id-rules (_status)

collects/ffi/unsafe/objc.rkt

@@ -269,7 +269,7 @@
        ((ctype-sizeof v) . <= . 16))]))
 
 ;; Make `msgSends' access atomic, so that a thread cannot be suspended
-;; or killed during access, whcih would block other threads.
+;; or killed during access, which would block other threads.
 (define-syntax-rule (as-atomic e)
   (begin (start-atomic) (begin0 e (end-atomic))))
 

collects/file/resource.rkt

@@ -0,0 +1,293 @@
+#lang racket/base
+(require ffi/unsafe
+         ffi/unsafe/define)
+
+(provide get-resource
+         write-resource)
+
+(define _HKEY (_cpointer/null 'HKEY))
+
+(define (const-hkey v)
+  (cast (bitwise-ior v (arithmetic-shift -1 32)) _intptr _HKEY))
+
+(define HKEY_CLASSES_ROOT   (const-hkey #x80000000))
+(define HKEY_CURRENT_USER   (const-hkey #x80000001))
+(define HKEY_LOCAL_MACHINE  (const-hkey #x80000002))
+(define HKEY_USERS          (const-hkey #x80000003))
+(define HKEY_CURRENT_CONFIG (const-hkey #x80000005))
+
+(define REG_SZ 1)
+(define REG_BINARY 3)
+(define REG_DWORD 4)
+
+(define (section->hkey who section)
+  (cond
+   [(equal? section "HKEY_CLASSES_ROOT")
+    HKEY_CLASSES_ROOT]
+   [(equal? section "HKEY_CURRENT_CONFIG")
+    HKEY_CURRENT_CONFIG]
+   [(equal? section "HKEY_CURRENT_USER")
+    HKEY_CURRENT_USER]
+   [(equal? section "HKEY_LOCAL_MACHINE")
+    HKEY_LOCAL_MACHINE]
+   [(equal? section "HKEY_USERS")
+    HKEY_USERS]
+   [(string? section) #f]
+   [else
+    (raise-type-error who "string" section)]))
+
+(define advapi-dll (and (eq? (system-type) 'windows)
+                     (ffi-lib "Advapi32.dll")))
+(define kernel-dll (and (eq? (system-type) 'windows)
+                        (ffi-lib "kernel32.dll")))
+
+(define-ffi-definer define-advapi advapi-dll
+  #:default-make-fail make-not-available)
+(define-ffi-definer define-kernel kernel-dll
+  #:default-make-fail make-not-available)
+
+(define win64? (equal? "win32\\x86_64" (path->string (system-library-subpath #f))))
+(define win_abi (if win64? #f 'stdcall))
+
+(define _LONG _long)
+(define _DWORD _int32)
+(define _REGSAM _DWORD)
+(define _BOOL (make-ctype _int (lambda (v) (if v 1 0)) (lambda (v) (not (zero? v)))))
+
+(define KEY_QUERY_VALUE #x1)
+(define KEY_SET_VALUE   #x2)
+
+(define ERROR_SUCCESS 0)
+
+(define-advapi RegOpenKeyExW (_fun #:abi win_abi
+                                   _HKEY _string/utf-16 _DWORD _REGSAM (hkey : (_ptr o _HKEY))
+                                   -> (r : _LONG)
+                                   -> (and (= r ERROR_SUCCESS) hkey)))
+(define-advapi RegCreateKeyExW (_fun #:abi win_abi
+                                     _HKEY _string/utf-16 (_DWORD = 0) 
+                                     (_pointer = #f) ; class
+                                     _DWORD ; options
+                                     _REGSAM
+                                     _pointer ; security
+                                     (hkey : (_ptr o _HKEY))
+                                     (_ptr o _DWORD) ; disposition
+                                     -> (r : _LONG)
+                                     -> (and (= r ERROR_SUCCESS) hkey)))
+
+(define-advapi RegQueryValueExW (_fun #:abi win_abi
+                                      _HKEY _string/utf-16 (_pointer = #f)
+                                      (type : (_ptr o _DWORD))
+                                      _pointer (len : (_ptr io _DWORD))
+                                      -> (r : _LONG)
+                                      -> (if (= r ERROR_SUCCESS) 
+                                             (values len type)
+                                             (values #f #f))))
+(define-advapi RegSetValueExW (_fun #:abi win_abi
+                                    _HKEY _string/utf-16 (_pointer = #f)
+                                    _DWORD _pointer _DWORD
+                                    -> (r : _LONG)
+                                    -> (= r ERROR_SUCCESS)))
+
+(define-advapi RegCloseKey (_fun #:abi win_abi _HKEY -> _LONG))
+
+(define-kernel WritePrivateProfileStringW (_fun #:abi win_abi
+                                                _string/utf-16 ; app
+                                                _string/utf-16 ; key
+                                                _string/utf-16 ; val
+                                                _string/utf-16 ; filename
+                                                -> _BOOL))
+(define-kernel GetPrivateProfileStringW (_fun #:abi win_abi
+                                              _string/utf-16 ; app
+                                              _string/utf-16 ; key
+                                              _string/utf-16 ; default
+                                              _pointer ; result
+                                              _DWORD ; result size in wide chars
+                                              _string/utf-16 ; filename
+                                              -> _DWORD))
+
+(define (file->ini f)
+  (cond
+   [(not f) (file->ini 
+             (build-path (find-system-path 'home-dir) "mred.ini"))]
+   [(string? f) (file->ini (string->path f))]
+   [(path? f) (path->string (cleanse-path (path->complete-path f)))]))
+
+(define (extract-sub-hkey file hkey entry op create-key?)
+  (cond
+   [(not (eq? 'windows (system-type))) (values #f #f)]
+   [file (values #f #f)]
+   [(regexp-match #rx"^(.*)\\\\+([^\\]*)$" entry)
+    => (lambda (m)
+         (let ([sub-hkey (RegOpenKeyExW hkey (cadr m) 0 op)]
+               [sub-entry (caddr m)])
+           (if (and (not sub-hkey)
+                    create-key?)
+               (values (RegCreateKeyExW hkey (cadr m) 0 op #f)
+                       sub-entry)
+               (values sub-hkey sub-entry))))]
+   [else (values hkey entry)]))
+
+(define (get-resource section entry [value #f] [file #f]
+                      #:type [rtype (or (and (box? value)
+                                             (or
+                                              (and (exact-integer? (unbox value))
+                                                   'integer)
+                                              (and (bytes? (unbox value))
+                                                   'bytes)))
+                                        'string)])
+  (define hkey (section->hkey 'get-resource section))
+  (unless (string? entry)
+    (raise-type-error 'get-resource "string" entry))
+  (unless (or (not value)
+              (and (box? value)
+                   (let ([value (unbox value)])
+                     (or (string? value) (bytes? value) (exact-integer? value)))))
+    (raise-type-error 'get-resource "box of string, byte string, or exact integer"))
+  (unless (or (not file)
+              (path-string? file))
+    (raise-type-error 'get-resource "path string or #f" file))
+  (unless (memq rtype '(string bytes integer))
+    (raise-type-error 'get-resource "'string, 'bytes, or 'integer" rtype))
+  
+  (define (to-rtype s)
+    (let ([to-string (lambda (s)
+                       (if (bytes? s)
+                           (bytes->string/utf-8 s #\?)
+                           s))])
+      (cond
+       [(eq? rtype 'string) (to-string s)]
+       [(eq? rtype 'integer)
+        (let ([n (string->number (to-string s))])
+          (or (and n (exact-integer? n) n)
+              0))]
+       [else
+        (if (string? s)
+            (string->bytes/utf-8 s)
+            s)])))
+
+  (define-values (sub-hkey sub-entry)
+    (extract-sub-hkey file hkey entry KEY_QUERY_VALUE #f))
+
+  (cond
+   [sub-hkey
+    (begin0
+     (let-values ([(len type) 
+                   ;; Get size, first
+                   (RegQueryValueExW sub-hkey sub-entry #f 0)])
+       (and len
+            (let ([s (make-bytes len)])
+              (let-values ([(len2 type2) 
+                            ;; Get value, now that we have a bytes string of the right size
+                            (RegQueryValueExW sub-hkey sub-entry s len)])
+                (and len2
+                     (let ([r
+                            ;; Unmarhsal according to requested type:
+                            (let ([s (cond
+                                      [(= type REG_SZ)
+                                       (cast s _pointer _string/utf-16)]
+                                      [(= type REG_DWORD)
+                                       (number->string (ptr-ref s _DWORD))]
+                                      [else
+                                       s])])
+                              (to-rtype s))])
+                       (if (box? value)
+                           (begin
+                             (set-box! value r)
+                             #t)
+                           r)))))))
+     (unless (eq? hkey sub-hkey)
+       (RegCloseKey sub-hkey)))]
+   [(eq? 'windows (system-type))
+    (let* ([SIZE 1024]
+           [dest (make-bytes (* SIZE 2) 0)]
+           [DEFAULT "$$default"]
+           [len (GetPrivateProfileStringW section entry DEFAULT
+                                          dest SIZE
+                                          (file->ini file))])
+      (let ([s (cast dest _pointer _string/utf-16)])
+        (and (not (equal? s DEFAULT))
+             (let ([r (to-rtype s)])
+               (if value
+                   (begin
+                     (set-box! value r)
+                     #t)
+                   r)))))]
+   [else #f]))
+
+(define (write-resource section entry value [file #f]
+                        #:type [type 'string]
+                        #:create-key? [create-key? #f])
+  (define hkey (section->hkey 'write-resource section))
+  (unless (string? entry)
+    (raise-type-error 'write-resource "string" entry))
+  (unless (or (string? value) (bytes? value) (exact-integer? value))
+    (raise-type-error 'write-resource "string, byte string, or exact integer"))
+  (unless (or (not file)
+              (path-string? file))
+    (raise-type-error 'write-resource "path string or #f" file))
+  (unless (memq type '(string bytes dword))
+    (raise-type-error 'write-resource "'string, 'bytes, or 'dword" type))
+
+  (define (to-string value)
+    (cond
+     [(exact-integer? value) (number->string value)]
+     [(string? value) value]
+     [else (bytes->string/utf-8 value #\?)]))
+
+  (define-values (sub-hkey sub-entry)
+    (extract-sub-hkey file hkey entry KEY_SET_VALUE create-key?))
+  
+  (cond
+   [sub-hkey
+    (begin0
+     (let ([v (case type
+                [(string) 
+                 (to-utf-16 (to-string value))]
+                [(bytes) 
+                 (cond
+                  [(exact-integer? value) 
+                   (string->bytes/utf-8 (number->string value))]
+                  [(string? value) (string->bytes/utf-8 value)]
+                  [else value])]
+                [(dword) 
+                 (to-dword-ptr
+                  (cond
+                   [(exact-integer? value) value]
+                   [(string? value) (string->number value)]
+                   [(bytes? value) 
+                    (string->number (bytes->string/utf-8 value #\?))]))])]
+           [ty (case type
+                 [(string) REG_SZ]
+                 [(bytes) REG_BINARY]
+                 [(dword) REG_DWORD])])
+       (RegSetValueExW sub-hkey sub-entry ty v (bytes-length v)))
+     (unless (eq? hkey sub-hkey)
+       (RegCloseKey sub-hkey)))]
+   [(eq? 'windows (system-type))
+    (WritePrivateProfileStringW section entry (to-string value) (file->ini file))]
+   [else #f]))
+
+(define (to-utf-16 s)
+  (let ([v (malloc _gcpointer)])
+    (ptr-set! v _string/utf-16 s)
+    (let ([p (ptr-ref v _gcpointer)])
+      (let ([len (* 2 (+ 1 (utf-16-length s)))])
+        (ptr-ref v (_bytes o len))))))
+
+(define (utf-16-length s)
+  (for/fold ([len 0]) ([c (in-string s)])
+    (+ len
+       (if ((char->integer c) . > . #xFFFF)
+           2
+           1))))
+
+(define (to-dword-ptr v)
+  (let ([v (if (and (exact-integer? v)
+                    (<= (- (expt 2 31))
+                        v
+                        (sub1 (expt 2 31))))
+               v
+               0)])
+    (let ([p (malloc _DWORD)])
+      (ptr-set! p _DWORD v)
+      (cast p _pointer (_bytes o (ctype-sizeof _DWORD))))))

collects/file/scribblings/file.scrbl

@@ -13,6 +13,7 @@
 @include-section["md5.scrbl"]
 @include-section["sha1.scrbl"]
 @include-section["gif.scrbl"]
+@include-section["resource.scrbl"]
 
 @(bibliography
   (bib-entry #:key "Gervautz1990"

collects/file/scribblings/resource.scrbl

@@ -0,0 +1,107 @@
+#lang scribble/doc
+@(require "common.ss"
+          (for-label file/resource))
+
+@(define-syntax-rule (compat file section indexed-racket what)
+   @elem{For backward compatibilty, the
+ result is @racket[#f] for platforms other than Windows. The registry
+ is @|what| when
+ @racket[file] is @racket[#f] and when @racket[section] is 
+ @indexed-racket["HKEY_CLASSES_ROOT"],
+ @indexed-racket["HKEY_CURRENT_CONFIG"],
+ @indexed-racket["HKEY_CURRENT_USER"],
+ @indexed-racket["HKEY_LOCAL_MACHINE"], or @indexed-racket["HKEY_USERS"].
+ When @racket[file] is @racket[#f] and @racket[section] is not one of
+ the special registry strings, then 
+ @racket[(build-path (find-system-path 'home-dir) "mred.ini")] 
+ is @|what|.})
+
+@title[#:tag "resource"]{Windows Registry}
+
+@defmodule[file/resource]
+
+@defproc[(get-resource [section string?]
+                       [entry string?]
+                       [value-box (or/f #f (box/c (or/c string? bytes? exact-integer?))) #f]
+                       [file (or/c #f fail-path?) #f]
+                       [#:type type (or/c 'string 'bytes 'integer) _derived-from-value-box])
+         (or/c #f string? bytes? exact-integer? #t)]{
+
+Gets a value from the Windows registry or an @filepath{.ini}
+ file. @compat[file section indexed-racket "read"]
+
+The resource value is keyed on the combination of @racket[section] and
+ @racket[entry].  The result is @racket[#f] if no value is found for
+ the specified @racket[section] and @racket[entry]. If @racket[value-box]
+ is a box, then the result is @racket[#t] if a value is found, and the
+ box is filled with the value; when @racket[value-box] is @racket[#f], the result is the found
+ value.
+
+The @racket[type] argument determines how a value in the resource is
+ converted to a Racket value. If @racket[value-box] is a box, then the
+ default @racket[type] is derived from the initial box content,
+ otherwise the default @racket[type] is @racket['string].
+
+Registry values of any format can be extracted. Values using the
+ registry format @tt{REG_SZ} are treated as strings, and values with
+ the format @tt{REG_DWORD} are treated as 32-bit signed integers. All
+ other formats are treated as raw bytes. Data from the registry is
+ converted to the requested @racket[type] as follows:
+
+@itemlist[
+
+ @item{A @tt{REG_SZ} registry value
+       is converted to an integer using
+       @racket[string->number] (using @racket[0] if the result is not
+       an exact integer), and it is converted to bytes using
+       @racket[string->bytes/utf-8].}
+
+ @item{A @tt{REG_DWORD} registry value is converted to a string or
+       byte string via @racket[number->string] and (for byte strings)
+       @racket[string->bytes/utf-8].}
+
+ @item{Any other kind of registry value is converted to a string or
+       integer using @racket[bytes->string/utf-8] and (for integers)
+       @racket[string->number].}
+
+]
+
+Resources from @filepath{.ini} files are always strings, and are
+converted like @tt{REG_SZ} registry values.
+
+To get the ``default'' value for a registry entry, use a trailing
+backslash. For example, the following expression gets a command line
+for starting a browser:
+
+@racketblock[
+  (get-resource "HKEY_CLASSES_ROOT" 
+                "htmlfile\\shell\\open\\command\\")
+]}
+
+@defproc[(write-resource [section string?]
+                         [entry string?]
+                         [value (or/c string? bytes? exact-integer?)]
+                         [file (or/c path-string? #f) #f]
+                         [#:type type (or/c 'string 'bytes 'integer) 'string]
+                         [#:create-key? create-key? any/c #f])
+         boolean?]{
+
+Write a value to the Windows registry or an @filepath{.ini}
+ file. @compat[file section racket "written"]
+
+The resource value is keyed on the combination of @racket[section] and
+ @racket[entry]. If @racket[create-key?] is false when writing to the
+ registry, the resource entry must already exist, otherwise the write
+ fails. The result is @racket[#f] if the write fails or @racket[#t] if
+ it succeeds.
+
+The @racket[type] argument determines the format of the value written to the
+ registry: @racket['string] writes using the @tt{REG_SZ} format,
+ @racket['bytes] writes using the @tt{REG_BINARY} format, and
+ @racket['dword] writes using the @tt{REG_DWORD} format. Any kind of
+ @racket[value] can be converted for any kind of @racket[type] using
+ the inverse of the conversions for @racket[get-resource].
+
+When writing to an @filepath{.ini} file, the format is always a
+ string, independent of @racket[type].}
+

collects/file/tar.rkt

@@ -22,7 +22,7 @@
          [len (bytes-length bts)])
     (if (< len tar-name-length)
       (values bts #f)
-      (let loop ([n 1]) ; seach for a split point
+      (let loop ([n 1]) ; search for a split point
         (cond [(<= (sub1 len) n)
                (error 'tar "path too long for USTAR: ~a" path)]
               [(and (eq? sep-char (bytes-ref bts n))

collects/framework/main.rkt

@@ -802,7 +802,7 @@
                          @scheme[filename].
                          @itemize[
                            @item{If a handler is found, it is applied to
-                                 @scheme[filename] and it's result is the final
+                                 @scheme[filename] and its result is the final
                                  result.}
                            @item{If not, @scheme[make-default] is used.}]}]}
       @item{If @scheme[filename] is @scheme[#f], @scheme[make-default] is

collects/framework/private/color.rkt

@@ -297,6 +297,14 @@ added get-regions
                        (get-token in in-start-pos in-lexer-mode)
                        (enable-suspend #t)))])
         (unless (eq? 'eof type)
+          (unless (exact-nonnegative-integer? new-token-start)
+            (error 'color:text<%> "expected an exact nonnegative integer for the token start, got ~e" new-token-start))
+          (unless (exact-nonnegative-integer? new-token-end)
+            (error 'color:text<%> "expected an exact nonnegative integer for the token end, got ~e" new-token-end))
+          (unless (exact-nonnegative-integer? backup-delta)
+            (error 'color:text<%> "expected an exact nonnegative integer for the backup delta, got ~e" backup-delta))
+          (unless (0 . < . (- new-token-end new-token-start))
+            (error 'color:text<%> "expected the distance between the start and end position for each token to be positive, but start was ~e and end was ~e" new-token-start new-token-end))
           (enable-suspend #f)
           #; (printf "~a at ~a to ~a\n" lexeme (+ in-start-pos (sub1 new-token-start))
                      (+ in-start-pos (sub1 new-token-end)))
@@ -825,20 +833,23 @@ added get-regions
 
     (define/public (get-token-range position)
       (define-values (tokens ls) (get-tokens-at-position 'get-token-range position))
-      (values (and tokens (+ (lexer-state-start-pos ls) 
+      (values (and tokens ls
+                   (+ (lexer-state-start-pos ls)
                       (send tokens get-root-start-position)))
-              (and tokens (+ (lexer-state-start-pos ls)
+              (and tokens ls
+                   (+ (lexer-state-start-pos ls)
                       (send tokens get-root-end-position)))))
 
     (define/private (get-tokens-at-position who position)
       (when stopped?
         (error who "called on a color:text<%> whose colorer is stopped."))
       (let ([ls (find-ls position)])
-        (and ls
+        (if ls
             (let ([tokens (lexer-state-tokens ls)])
                (tokenize-to-pos ls position)
                (send tokens search! (- position (lexer-state-start-pos ls)))
-               (values tokens ls)))))
+              (values tokens ls))
+            (values #f #f))))
     
     (define/private (tokenize-to-pos ls position)
       (when (and (not (lexer-state-up-to-date? ls)) 

collects/framework/private/group.rkt

@@ -256,7 +256,7 @@
       
       (define/public (locate-file name)
         (let* ([normalized
-                ;; allow for the possiblity of filenames that are urls
+                ;; allow for the possibility of filenames that are urls
                 (with-handlers ([(λ (x) #t)
                                  (λ (x) name)])
                   (normal-case-path

collects/framework/private/handler.rkt

@@ -209,7 +209,7 @@
   (let ([current-items 
          (map (λ (x) (and (is-a? x labelled-menu-item<%>) (send x get-label)))
               (send menu get-items))]
-        ;; the new-items variable shoudl match up to what install-recent-items actually does when it creates the menu 
+        ;; the new-items variable should match up to what install-recent-items actually does when it creates the menu 
         [new-items 
          (append 
           (for/list ([recent-list-item recently-opened-files])

collects/framework/private/panel.rkt

@@ -505,3 +505,119 @@
   
   (define horizontal-dragable% (horizontal-dragable-mixin (dragable-mixin panel%)))
 
+(define splitter<%> (interface () split-horizontal split-vertical collapse))
+;; we need a private interface so we can use `generic' because `generic'
+;; doesn't work on mixins
+(define splitter-private<%> (interface () self-vertical? self-horizontal?))
+
+(define splitter-mixin
+  (mixin (area-container<%> dragable<%>) (splitter<%> splitter-private<%>)
+    (super-new)
+    (inherit get-children add-child
+             delete-child
+             change-children
+             begin-container-sequence
+             end-container-sequence)
+
+    (field [horizontal-panel% horizontal-dragable%]
+           [vertical-panel% vertical-dragable%])
+
+    (define/public (self-vertical?)
+      (send this get-vertical?))
+    
+    (define/public (self-horizontal?)
+      (not (send this get-vertical?)))
+
+    ;; insert an item into a list after some element
+    ;; FIXME: this is probably a library function somewhere
+    (define/private (insert-after list before item)
+      (let loop ([so-far '()]
+                 [list list])
+        (cond
+          [(null? list) (reverse so-far)]
+          [(eq? (car list) before) (loop (cons item (cons before so-far))
+                                         (cdr list))]
+          [else (loop (cons (car list) so-far) (cdr list))])))
+
+    ;; replace an element with a list of stuff
+    ;; FIXME: this is probably a library function somewhere
+    (define/private (replace list at stuff)
+      (let loop ([so-far '()]
+                 [list list])
+        (cond
+          [(null? list) (reverse so-far)]
+          [(eq? (car list) at) (append (reverse so-far) stuff (cdr list))]
+          [else (loop (cons (car list) so-far) (cdr list))])))
+
+    ;; remove a canvas and merge split panels if necessary
+    ;; TODO: restore percentages
+    (define/public (collapse canvas)
+      (begin-container-sequence)
+      (for ([child (get-children)])
+        (cond
+          [(eq? child canvas)
+           (when (> (length (get-children)) 1)
+             (change-children
+               (lambda (old-children)
+                 (remq canvas old-children))))]
+          [(is-a? child splitter<%>)
+           (send child collapse canvas)]))
+      (change-children
+        (lambda (old-children)
+          (for/list ([child old-children])
+            (if (and (is-a? child splitter<%>)
+                     (= (length (send child get-children)) 1))
+              (let ()
+                (define single (car (send child get-children)))
+                (send single reparent this)
+                single)
+              child))))
+      (end-container-sequence))
+
+    ;; split a canvas by creating a new editor and either
+    ;; 1) adding it to the panel if the panel is already using the same
+    ;;   orientation as the split that is about to occur
+    ;; 2) create a new panel with the orientation of the split about to
+    ;;   occur and add a new editor
+    ;;
+    ;; in both cases the new editor is returned
+    (define/private (do-split canvas maker orientation? orientation% split)
+      (define new-canvas #f)
+      (for ([child (get-children)])
+        (cond
+          [(eq? child canvas)
+           (begin-container-sequence)
+           (change-children
+             (lambda (old-children)
+               (if (send-generic this orientation?)
+                 (let ([new (maker this)])
+                   (set! new-canvas new)
+                   (insert-after old-children child new))
+                 (let ()
+                   (define container (new (splitter-mixin orientation%)
+                                          [parent this]))
+                   (send canvas reparent container)
+                   (define created (maker container))
+                   (set! new-canvas created)
+                   ;; this throws out the old child but we should probably
+                   ;; try to keep it
+                   (replace old-children child (list container))))))
+           (end-container-sequence)]
+
+          [(is-a? child splitter<%>)
+           (let ([something (send-generic child split canvas maker)])
+             (when something
+               (set! new-canvas something)))]))
+        new-canvas)
+
+    ;; canvas (widget -> editor) -> editor
+    (define/public (split-horizontal canvas maker)
+      (do-split canvas maker (generic splitter-private<%> self-horizontal?)
+                horizontal-panel% (generic splitter<%> split-horizontal)))
+
+    ;; canvas (widget -> editor) -> editor
+    (define/public (split-vertical canvas maker)
+      (do-split canvas maker (generic splitter-private<%> self-vertical?)
+                vertical-panel% (generic splitter<%> split-vertical)))
+
+    ))

collects/framework/private/scheme.rkt

@@ -604,7 +604,7 @@
               [(not contains)
                ;; Something went wrong matching. Should we get here?
                (do-indent 0)]
-              #;  ;; disable this to accomodate PLAI programs; return to this when a #lang capability is set up.
+              #;  ;; disable this to accommodate PLAI programs; return to this when a #lang capability is set up.
               [(curley-brace-sexp?)
                ;; when we are directly inside an sexp that uses {}s,
                ;; we indent in a more C-like fashion (to help Scribble)

collects/framework/private/sig.rkt

@@ -57,7 +57,10 @@
      
      horizontal-dragable<%>
      horizontal-dragable-mixin
-     horizontal-dragable%))
+     horizontal-dragable%
+
+     splitter<%>
+     splitter-mixin))
   (define-signature panel^ extends panel-class^
     (dragable-container-size
      dragable-place-children))

collects/framework/private/text.rkt

@@ -2160,7 +2160,7 @@
     
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;;
-    ;; output port syncronization code
+    ;; output port synchronization code
     ;;
     
     ;; flush-chan : (channel (evt void))
@@ -3121,7 +3121,7 @@ designates the character that triggers autocompletion
             (show-options word start-pos end-pos completion-cursor)))))
     
     ;; Number -> String
-    ;; The word that ends at the current positon of the editor
+    ;; The word that ends at the current position of the editor
     (define/public (get-word-at current-pos)
       (let ([start-pos (box current-pos)]) 
         (find-wordbreak start-pos #f 'caret)

collects/frtime/core/mailbox.rkt

@@ -7,10 +7,12 @@
 (define (snoc x l) (append l (list x)))
 
 ; Define mailboxes
-(define-struct mailbox (manager control msgs))
+(define-struct mailbox (manager control))
 (define (new-mailbox)
   (define control-ch (make-channel))
-  (define msgs-ch (make-async-channel))
+  (define (thread-recv-evt)
+    (handle-evt (thread-receive-evt)
+                (lambda (e) (thread-receive))))
   ; Try to match one message
   (define (try-to-match req msg)
     (match req
@@ -32,7 +34,7 @@
            (list* msg (try-to-match* req msgs)))]))
   ; Accept new messages until we need to match one
   (define (not-on-receive msgs)
-    (sync (handle-evt msgs-ch
+    (sync (handle-evt (thread-recv-evt)
                       (lambda (new-msg)
                         (not-on-receive (snoc new-msg msgs))))
           (handle-evt control-ch
@@ -51,7 +53,7 @@
            [(not timeout) false]
            [(> elapsed timeout) 0]
            [else (/ (- timeout elapsed) 1000.0)]))
-       (define new-msg (sync/timeout wait-time msgs-ch))
+       (define new-msg (sync/timeout wait-time (thread-recv-evt)))
        (if new-msg
            (if (try-to-match req new-msg)
                (not-on-receive msgs)
@@ -63,17 +65,17 @@
     (thread
      (lambda ()
        (not-on-receive empty))))  
-  (make-mailbox manager control-ch msgs-ch))
+  (make-mailbox manager control-ch))
 
 (define-struct receive (reply-ch timeout timeout-thunk matcher))
 (define (mailbox-send! mb msg)
   (match mb
-    [(struct mailbox (thd _ msgs))
+    [(struct mailbox (thd _))
      (thread-resume thd)
-     (async-channel-put msgs msg)]))
+     (thread-send thd msg)]))
 (define (mailbox-receive mb timeout timeout-thunk matcher)
   (match mb
-    [(struct mailbox (thd control _))
+    [(struct mailbox (thd control))
      (define reply-ch (make-channel))
      (thread-resume thd)
      (channel-put control (make-receive reply-ch timeout timeout-thunk matcher))

collects/frtime/doc.txt

@@ -278,7 +278,7 @@ Generates a mixin that sends an event on stream-name when
 callback is called. The class has an init field called
 [stream-name]-event-processor, which is a function. The
 function is applied to an event stream that has an
-occurence every time callback is called, and the value
+occurrence every time callback is called, and the value
 of the events is a list of the arguments to the callback.
 The public method (get-[stream-name]) is a public method
 of the resulting class that gets the result of applying

collects/frtime/gui/demo/instr.rkt

@@ -38,7 +38,7 @@
 
 ; apply the mixin
 ; fr-value-text-field%s will set their value to the value of 
-; the event occurances supplied in the initialization argument
+; the event occurrences supplied in the initialization argument
 ; value-set-e
 (define fr-value-text-field% (set-value-lifter text-field%))
 

collects/frtime/gui/doc.txt

@@ -32,7 +32,7 @@ when the event should just be the value of the first
 argument of the callback. split-*-events/type sets up an
 appropriate split (see FrTime docs for split information,
 GRacket docs for key-event codes and mouse-event types) over
-the type of event occurence.
+the type of event occurrence.
 
                                                     
 events->callbacks and callbacks->args-evts are the backbone

collects/games/blackjack/blackjack.rkt

@@ -259,7 +259,7 @@
                                  (done "Bust" cont)
                                  (yield cont)))]
                  ;; Callback for the hit button; the button's callback is
-                 ;; changed for diferent modes: normal, split part 1, or split
+                 ;; changed for different modes: normal, split part 1, or split
                  ;; part 2
                  [make-hit-callback
                   (lambda (get-p set-p! player-region bust)

collects/games/chat-noir/chat-noir-literate.rkt

@@ -257,7 +257,7 @@ to @scheme[#f] and the state of the ``h'' key to
 
 
 The @scheme[empty-world] function
-generalizes the exmaple by computing the
+generalizes the example by computing the
 cats initial position as the center spot on the board.
 
 @chunk[<empty-world>

collects/games/crazy8s/crazy8s.rkt

@@ -523,7 +523,7 @@
                         (player-hand-r player)))
                 players)
 
-      ;; Opponents's cards and deck initally can't be moved
+      ;; Opponents's cards and deck initially can't be moved
       (for-each (lambda (card) (send card user-can-move #f))
                 (append
                  (apply append

collects/games/gobblet/model.rkt

@@ -445,7 +445,7 @@
 	    (let ([v (if who
 			 (compact-board board who)
 			 board)])
-	      ;; Find cannonical mapping.	      
+	      ;; Find canonical mapping.	      
 	      (hash-table-get 
                memory v
                (lambda ()

collects/games/gofish/gofish.rkt

@@ -126,7 +126,7 @@
                              (check-hand you (car cards))
                              (send t set-status YOUR-TURN-MESSAGE))))
 
-;; More card setup: Opponents's cards and deck initally can't be moved
+;; More card setup: Opponents's cards and deck initially can't be moved
 (for-each (lambda (card) (send card user-can-move #f))
           (append (player-hand player-1) (player-hand player-2) deck))
 

collects/games/jewel/jewel.scm

@@ -1431,7 +1431,7 @@
 		   
       )
 
-      ;; This shouldnt do anything, but it fixes drawing in 
+      ;; This shouldn't do anything, but it fixes drawing in 
       ;; Snow Leopard. Bug in the game or in Snow Leopard?
       (glEnable GL_LIGHT2)
       (glDisable GL_LIGHT2)

collects/games/parcheesi/moves.rkt

@@ -396,7 +396,7 @@
                [(safety? end)
                 (bad-move "cannot move onto a safety if someone else is already there")]
                
-               ;; succesful bop
+               ;; successful bop
                [else
                 (values
                  (move-piece2 board

collects/games/scribblings/paint-by-numbers.scrbl

@@ -39,7 +39,7 @@ permission to re-distribute their puzzles.  Visit them online at:
 @centerline{@selflink[;"http://www02.so-net.ne.jp/~kajitani/index.html"
                       "http://nonogram.freehostia.com/pbn/index.html"]}
 
-The specific contributers who have permitted their puzzles to be
+The specific contributors who have permitted their puzzles to be
 redistributed are:
 
 @verbatim[#:indent 2]{

collects/games/scribblings/pousse.scrbl

@@ -33,7 +33,7 @@ place.
 
 When a marker is inserted, there may be a marker on the square where
 the insertion takes place.  In this case, all markers on the insertion
-row or column from the insertion square upto the first empty square
+row or column from the insertion square up to the first empty square
 are moved one square further to make room for the inserted marker.
 Note that the last marker of the row or column will be pushed off the
 board (and must be removed from play) if there are no empty squares on

collects/graphics/scribblings/traditional-turtles.scrbl

@@ -99,7 +99,7 @@ For example
 ]
 
 moves a turtle forward 100 pixel while drawing a line, and then moves
-the turtle be immediately back to it's original position. Similarly,
+the turtle be immediately back to its original position. Similarly,
 
 @schemeblock[
 (tprompt (split (turn/radians (/ pi 2))))

collects/guibuilder/top-level.rkt

@@ -12,13 +12,13 @@
 	   "panel.ss")
   
   ;; INVARIANT: If a snip is selected, then no ancestor or
-  ;;  decendent of the snip can be selected. Otherwise, the
+  ;;  descendant of the snip can be selected. Otherwise, the
   ;;  dragging rules get complicated (perhaps impossible).
   
   ;; INVARIANT: a child must be ordered before its parent in the
   ;;  pasteboard. Not only does this affect drawing, but it also
   ;;  affects how select-all and rubber-banding work due to the
-  ;;  ancestor/decendent-selection-exclusion rule.
+  ;;  ancestor/descendant-selection-exclusion rule.
   
   (define START-FRAME-WIDTH 100)
   (define START-FRAME-HEIGHT 100)

collects/handin-server/main.rkt

@@ -326,7 +326,7 @@
      (put-preferences
       (list (string->symbol username)) (list data)
       (lambda (f)
-        (error* "user database busy; please try again, and alert the adminstrator if problems persist"))
+        (error* "user database busy; please try again, and alert the administrator if problems persist"))
       "users.rktd"))
    orig-custodian))
 

collects/help/bug-report.rkt

@@ -178,7 +178,7 @@
   
   ;; important that you cannot go back from this view, 
   ;; or else that might trigger saving the bug report in the preferences 
-  ;; (but when you're here the bug report should be succesfully submitted)
+  ;; (but when you're here the bug report should be successfully submitted)
   (define (switch-to-finished-view finished-text)
     (send finished-ec set-editor finished-text)
     (unsave-bug-report (saved-report-id init-bug-report))

collects/honu/core/private/honu.rkt

@@ -1026,7 +1026,7 @@
             (if (eq? #t (syntax-e #'type-name))
                 ;; Context guarantees correct use, as long as we report our type:
                 #'(honu-report-type val orig-expr val-type protect-id)
-                ;; Context gurantees use at a particular type...
+                ;; Context guarantees use at a particular type...
                 (if (check-compatible-type #'val #'orig-expr #'val-type #'type-name type-mismatch)
                     ;; Declared type subsumes actual type:
                     (if (and (syntax-e #'protect-id)

collects/htdp/arrow-gui.rkt

@@ -36,7 +36,7 @@
 ;; make-button-table : 
 ;;   panel% layout -> (listof (listof (union panel% button%)))
 ;; to translate a layout table into a button table 
-;;   each button is controled by (control a-bitmap)
+;;   each button is controlled by (control a-bitmap)
 (define (make-button-table panel layout)
   (local ((define (make-row a-row)
             (local ((define row-panel (make-object horizontal-panel% panel))

collects/htdp/arrow.rkt

@@ -61,7 +61,7 @@
 ;;   -> 
 ;;   (listof (listof (union panel% button%)))
 ;; to translate a layout table into a button table 
-;;   each button is controled by (control a-bitmap)
+;;   each button is controlled by (control a-bitmap)
 (define (make-button-table panel control layout)
   (define (make-row a-row)
     (define row-panel (make-object horizontal-panel% panel))

collects/htdp/big-draw.rkt

@@ -231,7 +231,7 @@
     ;; see ../htdch/draw/support.scm (copy) for explanation and design rationale
     (hash-set! h 'copy (lambda () (set! @vp vp*) (set! @pm pm*) [(clear-viewport pm*)]))
     ;; ---
-    ;; --- the following can't happend during a draw sequence --- 
+    ;; --- the following can't happen during a draw sequence --- 
     (set! %wait-for-mouse-click (lambda () (mouse-click-posn (get-mouse-click vp*))))      
     (set! %get-key-event
           (lambda ()

collects/htdp/convert.rkt

@@ -226,7 +226,7 @@
 
 ;; make-reader-for-f : (number -> number) -> ( -> void)
 ;; make-reader-for-f creates a function that reads numbers from a file
-;; converts them accoring to f, and prints the results
+;; converts them according to f, and prints the results
 ;; effect: if any of the S-expressions in the file aren't numbers or
 ;;         if any of f's results aren't numbers,
 ;;         the function signals an error

collects/htdp/tests/guess-gui.rkt

@@ -1,24 +0,0 @@
-;; The first three lines of this file were inserted by DrScheme. They record metadata
-;; about the language level of this file in a form that our tools can easily process.
-#reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname guess-gui) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
- ;; TeachPack : guess-gui.ss
-;; Language: Beginning 
-
-;; ------------------------------------------------------------------------
-;; model : button% event% -> true
-(define (model x y)
-  (view (convert (list (control 0) (control 1) (control 2)))))
-
-;; convert : (listof DIGIT) -> number 
-;; to convert a list of digits into a number 
-;; the leading digit is the least signifcant one
-(define (convert alod)
-  (cond
-    [(empty? alod) 0]
-    [else (+ (first alod) (* 10 (convert (rest alod))))]))
-
-;; TEST: 
-(connect model)
-
-
-

collects/htdp/tests/hangman-error.rkt

@@ -1,4 +1,4 @@
-;; The first three lines of this file were inserted by DrScheme. They record metadata
+;; The first three lines of this file were inserted by DrRacket. They record metadata
 ;; about the language level of this file in a form that our tools can easily process.
 #reader(lib "htdp-advanced-reader.ss" "lang")((modname hangman-error) (read-case-sensitive #t) (teachpacks ((lib "hangman.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #t #t none #f ((lib "hangman.ss" "teachpack" "htdp")))))
 (define (reveal-list chosen status guess)
@@ -11,4 +11,4 @@
 
 (start 200 200)
 (check-error (hangman-list reveal-list draw-next-part) 
-             "draw-next-part: result of type <boolean> expected, given: #<void>")
+             "draw-next-part: result of type <boolean> expected, your function produced #<void>")

collects/lazy/force.rkt

@@ -9,7 +9,7 @@
 (define ~? promise?)
 
 ;; force a top-level list structure; works with improper lists (will force the
-;; dotted item when it checks if its a pair); does not handle cycles
+;; dotted item when it checks if it's a pair); does not handle cycles
 (define (!list x)
   (let ([x (! x)])
     (if (list? x) ; cheap check,

collects/macro-debugger/model/reductions.rkt

@@ -1,5 +1,6 @@
 #lang racket/base
 (require racket/match
+         (for-syntax racket/base)
          "../util/eomap.rkt"
          "stx-util.rkt"
          "deriv-util.rkt"
@@ -34,9 +35,16 @@
 
 ;; Syntax
 
-(define-syntax-rule (match/count x . clauses)
+(define-syntax-rule (match/count x clause ...)
   (begin (sequence-number (add1 (sequence-number)))
-         (match x . clauses)))
+         (let ([v x])
+           (match v
+             clause ...
+             [_ (error 'match "failed to match ~e at line ~s" v (line-of x))]))))
+
+(define-syntax (line-of stx)
+  (syntax-case stx ()
+    [(line-of x) #`(quote #,(syntax-line #'x))]))
 
 ;; Derivations => Steps
 
@@ -472,7 +480,10 @@
         ;; Add remark step?
         ]]
     [(struct local-remark (contents))
-     (R [#:reductions (list (walk/talk 'remark contents))])]))
+     (R [#:reductions (list (walk/talk 'remark contents))])]
+
+    [#f
+     (R)]))
 
 ;; List : ListDerivation -> RST
 (define (List ld)

collects/macro-debugger/syntax-browser/widget.rkt

@@ -117,8 +117,8 @@
             (send -text change-style clickback-style a b)))))
 
     (define/public (add-syntax stx
-                               #:binders [binders #f]
+                               #:binders [binders '#hash()]
-                               #:shift-table [shift-table #f]
+                               #:shift-table [shift-table '#hash()]
                                #:definites [definites #f]
                                #:hi-colors [hi-colors null]
                                #:hi-stxss [hi-stxss null]

collects/macro-debugger/view/step-display.rkt

@@ -84,9 +84,9 @@
              (show-poststep step shift-table)]))
 
     (define/public (add-syntax stx
-                               #:binders [binders #f]
+                               #:binders [binders '#hash()]
                                #:definites [definites #f]
-                               #:shift-table [shift-table #f])
+                               #:shift-table [shift-table '#hash()])
       (send/i sbview sb:syntax-browser<%> add-syntax stx
               #:binders binders
               #:definites definites

collects/meta/dist-specs.rkt

@@ -50,7 +50,7 @@
 ;;     clauses.  Instead of a single <tag>, you can use a list of tags.  The
 ;;     tags are expanded using definitions made with :=tag, and the result is
 ;;     added to current tag list -- this expansion is a little different from
-;;     the normal one in that the result contains all of the defintion it went
+;;     the normal one in that the result contains all of the definition it went
 ;;     through (so if x expands to y which expands to z, expanding x will
 ;;     result in x, y, and z).
 ;; Finally, it is possible to define `macro' constructs by using a lambda spec:
@@ -164,7 +164,7 @@ gui-filter      := (- (+ (collects: "**/gui/") (srcfile: "gui.rkt"))
                       (srcfile: "racket/gui/dynamic.rkt"))
 tools-filter    := (+ (collects: "**/tools/") (srcfile: "tools.rkt"))
 
-;; these are in the doc directory, but are comitted in git and should be
+;; these are in the doc directory, but are committed in git and should be
 ;; considered like sources
 std-docs        := (doc: "doc-license.txt" "*-std/")
 

collects/meta/props

@@ -1465,7 +1465,7 @@ path/s is either such a string or a list of them.
 "collects/tests/frtime" responsible (gcooper jay)
 "collects/tests/frtime/time.rkt" drdr:command-line (gracket-text "-t" *)
 "collects/tests/future" responsible (jamesswaine mflatt robby)
-"collects/tests/future/random-future.rkt" drdr:timeout 240
+"collects/tests/future/random-future.rkt" drdr:timeout 480
 "collects/tests/gracket" responsible (mflatt)
 "collects/tests/gracket/auto.rktl" drdr:command-line #f
 "collects/tests/gracket/blits.rkt" drdr:command-line (gracket "-f" *)
@@ -1899,6 +1899,7 @@ path/s is either such a string or a list of them.
 "collects/tests/stepper/already-defined.rktl" drdr:command-line #f
 "collects/tests/stepper/automatic-tests.rkt" drdr:timeout 600
 "collects/tests/stepper/bad-letrec-test.rktl" drdr:command-line #f
+"collects/tests/stepper/big-bang-test.rkt" drdr:command-line (mzc *)
 "collects/tests/stepper/constructor-redexes.rktl" drdr:command-line #f
 "collects/tests/stepper/global-prim-reduction.rktl" drdr:command-line #f
 "collects/tests/stepper/image-test.rktl" drdr:command-line #f

collects/meta/web/stubs/pre.rkt

@@ -214,7 +214,7 @@
       mentioned above, for other platforms or something other than retrieving a
       full build.
     @~
-      This script will retreive and install a new build only when one is ready.
+      This script will retrieve and install a new build only when one is ready.
       It is suitable for running periodically via a crontab entry.  For
       example, save it in @tt{~/bin/update-full-racket}, run @tt{crontab -e} to
       edit your @tt{crontab} entries, and add a line that looks like this:
@@ -235,8 +235,8 @@
             @~ Use variable definitions to make customization easy.
             @~ Usages of @tt{$URL} and others are quoted in case they will ever
                contain spaces.
-            @~ If we fail to retreive a file, we quit the script.
+            @~ If we fail to retrieve a file, we quit the script.
-            @~ Use a temporary directory to retreive the tree, and then move it
+            @~ Use a temporary directory to retrieve the tree, and then move it
                to its real place (so if it fails we don't end up with no
                @tt{racket}) through renaming (if we delete @tt{racket} and then
                rename the new one, we might fail halfway into the deletion).

collects/meta/web/www/irc.rkt

@@ -11,9 +11,14 @@
   @page[#:title "IRC" #:part-of 'community]{
     @iframe[src: webchat-link width: "100%" height: "400"]})
 
-(define irc-logs-symlink
+(define irc-logs
-  (symlink "/home/scheme/irc-logs/racket/" "irc-logs"))
+  (let ()
-(define (irc-logs text) @a[href: (list irc-logs-symlink "/")]{@text})
+    @plain[#:file "irc-logs/.htaccess" #:referrer values]{
+      RewriteEngine on
+      RewriteRule ^(.*)$ http://pre.racket-lang.org@;
+         /irc-logs/@||racket/@|"$1"| [P]
+    }
+    (lambda (text) @a[href: "irc-logs/"]{@text})))
 
 (define (irc-quick)
   @parlist[@strong{Discussion Channel}

collects/mred/info.rkt

@@ -1,4 +1,4 @@
 #lang setup/infotab
 
-(define version '(400))
+(define version '(510))
 (define post-install-collection "installer.rkt")

collects/mred/mred-sig.rkt

@@ -91,6 +91,7 @@ get-panel-background
 get-ps-setup-from-user
 get-highlight-background-color
 get-highlight-text-color
+get-resource
 get-text-from-user
 get-the-editor-data-class-list
 get-the-snip-class-list
@@ -210,4 +211,5 @@ window<%>
 write-editor-global-footer
 write-editor-global-header
 write-editor-version
+write-resource
 yield

collects/mred/private/misc.rkt

@@ -48,7 +48,7 @@
       ;; the alarm is immediately ready. This makes `sleep/yield'
       ;; more like `sleep':
       (wx:yield) 
-      ;; Now, realy sleep:
+      ;; Now, really sleep:
       (wx:yield evt))
     (void))
 

collects/mred/private/mred.rkt

@@ -5,6 +5,7 @@
                  make-base-empty-namespace)
            scheme/class
            racket/draw racket/snip
+           file/resource
            mzlib/etc
 	   (prefix wx: "kernel.ss")
 	   (prefix wx: "wxme/editor.ss")
@@ -169,7 +170,8 @@
           [else #f])))
 
   (provide (all-from racket/draw)
-           (all-from racket/snip))
+           (all-from racket/snip)
+           (all-from file/resource))
 
   (provide button%
 	   canvas%

collects/mred/private/seqcontract.rkt

@@ -410,13 +410,13 @@ Matthew
      set-before ;SetBefore
      set-after ;SetAfter
      ;ReallyCanEdit -- only when op != wxEDIT_COPY
-     ;Refresh has wierd code checking writeLocked -- what does < 0 mean?
+     ;Refresh has weird code checking writeLocked -- what does < 0 mean?
      do-paste ; DoPaste
      paste ; Paste
      insert-port ; InsertPort
      insert-file ; InsertFile
      read-from-file ; ReadFromFile
-     ; BeginEditSequence ;; -- wierd flag check
+     ; BeginEditSequence ;; -- weird flag check
-     ; EndEditSequence ;; -- wierd flag check, like BeginEditSequence
+     ; EndEditSequence ;; -- weird flag check, like BeginEditSequence
   
   |#

collects/mred/private/wx/cocoa/gauge.rkt

@@ -32,8 +32,8 @@
 
   (super-new [parent parent]
              [cocoa (let ([cocoa (as-objc-allocation
-                                  ;; Beware that a guage may be finally deallocated in 
+                                  ;; Beware that a gauge may be finally deallocated in 
-                                  ;; a seperate OS-level thread
+                                  ;; a separate OS-level thread
                                   (tell (tell MyProgressIndicator alloc) init))])
                       (tellv cocoa setIndeterminate: #:type _BOOL #f)
                       (tellv cocoa setMaxValue: #:type _double* rng)

collects/mred/private/wx/cocoa/radio-box.rkt

@@ -26,6 +26,9 @@
   #:mixins (FocusResponder KeyMouseResponder CursorDisplayer)
   [wxb]
   (-a _void (clicked: [_id sender])
+      ;; In case we were in 0-item mode, switch to Radio mode to
+      ;; ensure that only one button is selected:
+      (tellv self setAllowsEmptySelection: #:type _BOOL #f)
       (queue-window*-event wxb (lambda (wx) (send wx clicked)))))
 
 (define-objc-class MyImageButtonCell NSButtonCell
@@ -126,16 +129,21 @@
   (define/public (set-selection i)
     (if (= i -1)
         (begin
-          ;; Need to change to NSListModeMatrix to disable all.
+          (tellv (get-cocoa) setAllowsEmptySelection: #:type _BOOL #t)
-          ;; It seem that we don't have to change the mode back, for some reason.
-          (tellv (get-cocoa) setMode: #:type _int NSListModeMatrix)
           (tellv (get-cocoa) deselectAllCells))
+        (begin
           (tellv (get-cocoa) selectCellAtRow: #:type _NSInteger (if horiz? 0 i)
-               column: #:type _NSInteger (if horiz? i 0))))
+                 column: #:type _NSInteger (if horiz? i 0))
+          (tellv (get-cocoa) setAllowsEmptySelection: #:type _BOOL #f))))
   (define/public (get-selection)
-    (if horiz?
+    (let ([c (tell (get-cocoa) selectedCell)]
+          [pos (if horiz?
                    (tell #:type _NSInteger (get-cocoa) selectedColumn)
-        (tell #:type _NSInteger (get-cocoa) selectedRow)))
+                   (tell #:type _NSInteger (get-cocoa) selectedRow))])
+      (if (and c
+               (positive? (tell #:type _NSInteger c state)))
+          pos
+          -1)))
   (define/public (number) count)
 
   (define/override (maybe-register-as-child parent on?)

collects/mred/private/wx/cocoa/slider.rkt

@@ -8,6 +8,7 @@
          "const.rkt"
          "utils.rkt"
          "window.rkt"
+         "queue.rkt"
          "../common/event.rkt"
          "../common/queue.rkt"
          "../common/freeze.rkt"
@@ -158,6 +159,12 @@
   (define/public (update-message [val (get-value)])
     (tellv message-cocoa setTitleWithMnemonic: #:type _NSString (format "~a" val)))
 
+  (inherit get-cocoa-window)
+  (define/override (post-mouse-down)
+    ;; For some reason, dragging a slider disabled mouse-moved
+    ;;  events for the window, so turn them back on:
+    (tellv (get-cocoa-window) setAcceptsMouseMovedEvents: #:type _BOOL #t))
+
   (define/override (maybe-register-as-child parent on?)
     (register-as-child parent on?)))
 

collects/mred/private/wx/cocoa/window.rkt

@@ -98,7 +98,10 @@
   [wxb]
   [-a _void (mouseDown: [_id event]) 
       (unless (do-mouse-event wxb event 'left-down #t #f #f 'right-down)
-        (super-tell #:type _void mouseDown: event))]
+        (super-tell #:type _void mouseDown: event)
+        (let ([wx (->wx wxb)])
+         (when wx
+           (send wx post-mouse-down))))]
   [-a _void (mouseUp: [_id event]) 
       (unless (do-mouse-event wxb event 'left-up #f #f #f 'right-up)
         (super-tell #:type _void mouseUp: event))]
@@ -727,6 +730,8 @@
                              [caps-down #f])
                         #f))
 
+    (define/public (post-mouse-down) (void))
+
     (define/public (on-char s) (void))
     (define/public (on-event m) (void))
     (define/public (queue-on-size) (void))

collects/mred/private/wx/gtk/frame.rkt

@@ -216,7 +216,7 @@
         (adjust-client-delta 0 h))
       ;; Hack: calls back into the mred layer to re-compute
       ;;  sizes. By calling this early enough, the frame won't 
-      ;;  grow if it doesn't have to grow to accomodate the menu bar.
+      ;;  grow if it doesn't have to grow to accommodate the menu bar.
       (send this resized))
 
     (define saved-enforcements (vector 0 0 -1 -1))

collects/mred/private/wx/win32/gl-context.rkt

@@ -137,7 +137,7 @@
                              PFD_SUPPORT_GDI)
                 (bitwise-ior PFD_DRAW_TO_WINDOW)))
            PFD_TYPE_RGBA ; color type
-           (if offscreen? 32 24) ; prefered color depth
+           (if offscreen? 32 24) ; preferred color depth
            0 0 0 0 0 0 ; color bits (ignored)
            0 ; no alpha buffer
            0 ; alpha bits (ignored)

collects/mred/private/wx/win32/radio-box.rkt

@@ -49,6 +49,7 @@
     (define label-bitmaps null)
 
     (define radio-hwnds
+      (let ([horiz? (memq 'horizontal style)])
         (let loop ([y 0] [w 0] [labels labels])
           (if (null? labels)
               (begin
@@ -80,11 +81,15 @@
                 (set-control-font font radio-hwnd)
                 (let-values ([(w1 h) 
                               (auto-size font label 0 0 20 4
-                                       (lambda (w h)
+                                         (lambda (w1 h1)
-                                         (MoveWindow radio-hwnd 0 (+ y SEP) w h #t)
+                                           (if horiz?
-                                         (values w h)))])
+                                               (MoveWindow radio-hwnd (+ w SEP) 0 w1 h1 #t)
+                                               (MoveWindow radio-hwnd 0 (+ y SEP) w1 h1 #t))
+                                           (values w1 h1)))])
                   (cons radio-hwnd
-                      (loop (+ y SEP h) (max w1 w) (cdr labels))))))))
+                        (loop (if horiz? (max y h) (+ y SEP h))
+                              (if horiz? (+ w SEP w1) (max w1 w))
+                              (cdr labels)))))))))
 
     (unless (= val -1)
       (SendMessageW (list-ref radio-hwnds val) BM_SETCHECK 1 0))

collects/mred/private/wxme/editor-snip.rkt

@@ -111,7 +111,7 @@
 
     (when (and s-admin
                (has-flag? s-flags USES-BUFFER-PATH))
-      ;; propogate a filename change:
+      ;; propagate a filename change:
       (if (and editor
                (no-permanent-filename? editor))
           (let ([b (send s-admin get-editor)])

collects/mred/private/wxme/mline.rkt

@@ -1039,7 +1039,7 @@ Debugging tools:
               [next (mline-next mline)])
           (when (or (not (eq? (mline-snip next) asnip))
                     (not (has-flag? (snip->flags (mline-last-snip next)) NEWLINE)))
-            ;; Effect can propogate to more lines, merging the
+            ;; Effect can propagate to more lines, merging the
             ;; next several. (Handle prefixing the remains of the source of
             ;; the extension to this line onto the next line. Implemented
             ;; as the next line eating the next->next line.) 

collects/mred/private/wxme/pasteboard.rkt

@@ -1729,10 +1729,10 @@
               (set-box! h total-height))
             (send s-admin get-view x y w h #t))
       (let ([w (if (w . > . 1000.0)
-                   500.0 ; don't belive it
+                   500.0 ; don't believe it
                    w)]
             [h (if (h . > . 1000.0)
-                   500.0 ; don't belive it
+                   500.0 ; don't believe it
                    h)])
         (values (/ w 2)
                 (/ h 2)))))

collects/mred/private/wxme/text.rkt

@@ -2849,7 +2849,7 @@
                                     (set! write-locked? #t)
                                     (set! flow-locked? #t)
 
-                                    ;; linear seach for snip
+                                    ;; linear search for snip
                                     (let ([topy (mline-get-location line)])
                                       (let loop ([snip (mline-snip line)]
                                                  [X X]
@@ -3159,7 +3159,7 @@
                               (values (mline-last-snip line) (+ horiz (- (mline-w line) (mline-last-w line)))
                                       start #f)]
                              [else
-                              ;; linear seach for snip
+                              ;; linear search for snip
                               (let loop ([snip (mline-snip line)]
                                          [start start]
                                          [horiz horiz]

collects/mrlib/cache-image-snip.rkt

@@ -21,7 +21,7 @@
 
     The true meaning of an image is a vector of rationals,
     between 0 & 255, representing color and alpha channel
-    information. The vector's contents are analagous to
+    information. The vector's contents are analogous to
     the last argument to the get-argb-pixels method. That is,
     there are (* 4 w h) entries in the vector for an image
     of width w and height h, and the entries represent the

collects/mrlib/image-core.rkt

@@ -255,7 +255,7 @@ has been moved out).
                  (or (and (not (skip-image-equality-fast-path))  ;; this is here to make testing more effective
                           (equal? (get-normalized-shape) (send that get-normalized-shape)))
                      (let ([w (+ 1 (round (inexact->exact (bb-right bb))))]    ;; some shapes (ie, rectangles) draw 1 outside the bounding box
-                           [h (+ 1 (round (inexact->exact (bb-bottom bb))))])  ;; so we make the bitmap slightly bigger to accomodate that.
+                           [h (+ 1 (round (inexact->exact (bb-bottom bb))))])  ;; so we make the bitmap slightly bigger to accommodate that.
                        (or ;(zero? w)
                            ;(zero? h)
                            (let ([bm1 (make-bitmap w h #t)]

collects/mrlib/name-message.rkt

@@ -255,7 +255,7 @@
           (+ border-inset 
              circle-spacer
              button-label-inset
-             (if (eq? (system-type) 'windows) 1 0)  ;; becuase "(define ...)" has the wrong size under windows
+             (if (eq? (system-type) 'windows) 1 0)  ;; because "(define ...)" has the wrong size under windows
              (max 0 (inexact->exact (ceiling tw)))
              button-label-inset
              triangle-width

collects/mrlib/private/aligned-pasteboard/alignment.rkt

@@ -1,19 +1,19 @@
 #|
-This code computes the sizees for the rectangles in the space using the on dimention
+This code computes the sizees for the rectangles in the space using the on dimension
-off dimention method of referencing sizes. This means for example instead of saying
+off dimension method of referencing sizes. This means for example instead of saying
-width we say off dimention for vertical alignment. Inorder to consume and return
+width we say off dimension for vertical alignment. Inorder to consume and return
 the values in terms of width and height manipulation had to be done. I chose to create
 a struct abs-rect (abstract rectangle) and have code map horizontal and vertical rect
 stucts on to them. This code is a bit long but more readable than the other two options
 I came up with.
   1) define all functions to be letrec bound functions inside align. align then take
-     accessors for the rect struct. The caller of align swaps the order of ondimention
+     accessors for the rect struct. The caller of align swaps the order of ondimension
-     and off dimention accessors for vertical or horizontal code. This method does not
+     and off dimension accessors for vertical or horizontal code. This method does not
      allow the use of the readable, short, consis pattern matching code. As some of the
      matching code is easily removed this may be a good option but a large letrec
      is harder to write tests for.
   2) define a pattern matcher syntax that will match the struct rect but swap the fields
-     based on wich on is the on or off dimention. This would have been shorter but much
+     based on wich on is the on or off dimension. This would have been shorter but much
      more confusing.
 The current implementation requires align to map over the rects and allocate new stucts
 for each one on both passing into and returning from stretch-to-fit; This is not a bottle
@@ -141,7 +141,7 @@ neck and it is the most readable solution.
                    (loop rest-rects (+ onpos onsize))))]))))
   
   ;; waner (natural-number? . -> . (-> (union 1 0)))
-  ;; makes a thunk that returns 1 for it's first n applications, zero otherwise
+  ;; makes a thunk that returns 1 for its first n applications, zero otherwise
   (define (waner n)
     (lambda ()
       (if (zero? n)

collects/mrlib/private/aligned-pasteboard/geometry-managed-pasteboard.rkt

@@ -50,7 +50,7 @@
                        (get-aligned-min-sizes type (find-first-snip)))))
       
       ;; set-algined-min-sizes (-> void?)
-      ;; set the aligned min width and height of the pasteboard based on it's children snips
+      ;; set the aligned min width and height of the pasteboard based on its children snips
       (inherit in-edit-sequence?)
       (define/public (aligned-min-sizes-invalid)
         ;; This in-edit-sequence? is not sound. It causes me to percollate invalidation

collects/mrlib/private/aligned-pasteboard/pasteboard-lib.rkt

@@ -27,7 +27,7 @@
         [else pasteboard])))
 
   ;; gets the canvas or snip that the pasteboard is displayed in
-  ;; status: what if there is more than one canvas? should this be allowed? probablly not.
+  ;; status: what if there is more than one canvas? should this be allowed? probably not.
   (define (pasteboard-parent pasteboard)
     (let ([admin (send pasteboard get-admin)])
       (cond

collects/mrlib/private/image-core-bitmap.rkt

@@ -27,7 +27,7 @@ instead of this scaling code, we use the dc<%>'s scaling code.
  
                   
 ; bmbytes: a bytes which represents an image -- 
-; it's size is a multiple of 4, and each
+; its size is a multiple of 4, and each
 ; four consecutive bytes represent alpha,r,g,b.
 
                   

collects/mrlib/scribblings/tex-table.scrbl

@@ -14,7 +14,7 @@
                            (= (string-length x)
                               1)))))]{
 
-  This is an assocation list mapping the shortcut strings that
+  This is an association list mapping the shortcut strings that
   DrRacket uses with its @tt{control-\} (or @tt{command-\}) strings to
   their corresponding unicode characters. For example, it contains
   this mapping:

collects/mzlib/kw.rkt

@@ -128,7 +128,7 @@
        [else (ormap (lambda (k) (and (assq k rests) #t)) ; suggested?
                     (car (cddddr processed-spec)))])))
   (define (make-keyword-get-expr key rest default known-vars)
-    ;; expand (for id macros) and check if its a simple expression, because if
+    ;; expand (for id macros) and check if it's a simple expression, because if
     ;; it is, evaluation cannot have side-effects and we can use keyword-get*
     (define default*
       (local-expand default 'expression (cons #'#%app known-vars)))

collects/mzlib/sandbox.rkt

@@ -36,7 +36,7 @@
 ;; Compatbility:
 ;;   * recognize 'r5rs, etc, and wrap them as a list.
 ;;   * 'begin form of reqs
-;;   * more agressively extract requires from lang and reqs
+;;   * more aggressively extract requires from lang and reqs
 (define *make-evaluator
   (case-lambda
     [(lang reqs . progs)

collects/mzlib/thread.rkt

@@ -7,7 +7,7 @@
 
   #|
   t accepts a function, f, and creates a thread. It returns the thread and a
-  function, g. When g is applied it passes it's argument to f, and evaluates
+  function, g. When g is applied it passes its argument to f, and evaluates
   the call of f in the time of the thread that was created. Calls to g do not
   block.
   |#

collects/mzscheme/examples/README

@@ -28,7 +28,7 @@ end use the mzc `c-lambda', etc. forms.
    exceptions while evaluating a string. Demonstrates how to catch
    exceptions from C code.
 
- * bitmatrix.c - implements two-dimentional bit matrixes with some
+ * bitmatrix.c - implements two-dimensional bit matrixes with some
    operations. Demonstrates defining a new Scheme data type, data
    allocation, fancy integer type checking, general exception raising,
    and registering static variables. Also demonstrates supplying

collects/mzscheme/examples/bitmatrix.c

@@ -46,7 +46,7 @@ END_XFORM_SKIP;
 #endif
 
 /* We'll get some Scheme primitives so we can calculate with numbers
-   taht are potentially bignums: */
+   that are potentially bignums: */
 static Scheme_Object *mult, *add, *sub, *modulo, *neg;
 
 /* The type tag for bit matrixes, initialized with scheme_make_type */