clean up handling of not-ok?', bitmap-dc%'-selected, and mutated bitmaps

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

@@ -54,12 +54,10 @@
       (cond
        [(string? label)
         (tellv cocoa setTitleWithMnemonic: #:type _NSString label)]
-       [(send label ok?)
+       [else
         (if button-type
             (tellv cocoa setTitle: #:type _NSString "")
-            (tellv cocoa setImage: (bitmap->image label)))]
+            (tellv cocoa setImage: (bitmap->image label)))])
-       [else
-        (tellv cocoa setTitle: #:type _NSString "<bad>")])
       (init-font cocoa font)
       (tellv cocoa sizeToFit)
       (when (and (eq? event-type 'button)
@@ -89,8 +87,7 @@
 
   (define-values (cocoa image-cocoa)
     (if (and button-type
-             (not (string? label))
+             (not (string? label)))
-             (send label ok?))
         ;; Check-box image: need an view to join a button and an image view:
         ;; (Could we use the NSImageButtonCell from the radio-box implementation
         ;;  instead?)

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

@@ -80,8 +80,7 @@
              [cocoa (let* ([label (cond
                                    [(string? label) label]
                                    [(symbol? label) (get-icon label)]
-                                   [(send label ok?) label]
+                                   [else label])]
-                                   [else "<bad>"])]
                            [cocoa
                             (if (string? label)
                                 (as-objc-allocation

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

@@ -85,8 +85,7 @@
                   (let ([button (tell cocoa 
                                       cellAtRow: #:type _NSInteger (if horiz? 0 i)
                                       column: #:type _NSInteger (if horiz? i 0))])
-                    (if (and (not (string? label))
+                    (if (not (string? label))
-                             (send label ok?))
                         (begin
                           (tellv button setTitle: #:type _NSString "")
                           (set-ivar! button img (bitmap->image label)))

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

@@ -46,7 +46,7 @@
                    [(or (string? label) (not label))
                     (as-gtk-allocation
                      (gtk_new_with_mnemonic (or (mnemonic-string label) "")))]
-                   [(send label ok?)
+                   [else
                     (let ([pixbuf (bitmap->pixbuf label)])
                       (atomically
                        (let ([gtk (as-gtk-allocation (gtk_new))]
@@ -54,9 +54,7 @@
                          (release-pixbuf pixbuf)
                          (gtk_container_add gtk image-gtk)
                          (gtk_widget_show image-gtk)
-                         gtk)))]
+                         gtk)))])]
-                   [else
-                    (as-gtk-allocation (gtk_new_with_mnemonic "<bad>"))])]
              [callback cb]
              [font font]
              [no-show? (memq 'deleted style)])

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

@@ -60,14 +60,11 @@
                              [(caution) (gtk_image_new_from_stock "gtk-dialog-warning" icon-size)]
                              [(stop) (gtk_image_new_from_stock "gtk-dialog-error" icon-size)]
                              [else (gtk_image_new_from_stock "gtk-dialog-question" icon-size)]))
-                          (if (send label ok?)
                           (let ([pixbuf (bitmap->pixbuf label)])
                             (begin0
                              (as-gtk-allocation
                               (gtk_image_new_from_pixbuf pixbuf))
-                                 (release-pixbuf pixbuf)))
+                             (release-pixbuf pixbuf)))))]
-                              (as-gtk-allocation
-                               (gtk_label_new_with_mnemonic "<bad-image>")))))]
              [font font]
              [no-show? (memq 'deleted style)])
 

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

@@ -54,16 +54,14 @@
                         (let ([radio-gtk (cond
                                           [(string? lbl)
                                            (gtk_radio_button_new_with_mnemonic #f (mnemonic-string lbl))]
-                                          [(send lbl ok?)
+                                          [else
                                            (let ([pixbuf (bitmap->pixbuf lbl)])
                                              (let ([radio-gtk (gtk_radio_button_new #f)]
                                                    [image-gtk (gtk_image_new_from_pixbuf pixbuf)])
                                                (release-pixbuf pixbuf)
                                                (gtk_container_add radio-gtk image-gtk)
                                                (gtk_widget_show image-gtk)
-                                               radio-gtk))]
+                                               radio-gtk))])])
-                                          [else
-                                           (gtk_radio_button_new_with_mnemonic #f "<bad bitmap>")])])
                           (gtk_box_pack_start gtk radio-gtk #t #t 0)
                           (install-control-font (gtk_bin_get_child radio-gtk) font)
                           (gtk_widget_show radio-gtk)

collects/mred/private/wx/win32/button.rkt

@@ -27,9 +27,7 @@
 
     (define callback cb)
 
-    (define bitmap?
+    (define bitmap? (label . is-a? . bitmap%))
-      (and (label . is-a? . bitmap%)
-           (send label ok?)))
 
     (define/public (get-class) "PLTBUTTON")
     (define/public (get-flags) BS_PUSHBUTTON)

collects/mred/private/wx/win32/message.rkt

@@ -71,9 +71,7 @@
           x y
           style font)
 
-    (define bitmap?
+    (define bitmap? (label . is-a? . bitmap%))
-      (and (label . is-a? . bitmap%)
-           (send label ok?)))
 
     (define/public (get-class) "PLTSTATIC")
     

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

@@ -55,8 +55,7 @@
               (MoveWindow hwnd 0 0 w y #t)
               null)
             (let* ([label (car labels)]
-                   [bitmap? (and (label . is-a? . bitmap%)
+                   [bitmap? (label . is-a? . bitmap%)]
-                                 (send label ok?))]
                    [radio-hwnd 
                     (CreateWindowExW/control 0
                                              "PLTBUTTON"

collects/racket/draw/private/bitmap.rkt

@@ -75,6 +75,9 @@
                        (get-output-bytes s))]
                     [else default]))])))
 
+(define (get-empty-surface)
+  (cairo_image_surface_create CAIRO_FORMAT_ARGB32 1 1))
+
 (define bitmap%
   (class* object% (png-convertible<%>)
 
@@ -200,10 +203,10 @@
 
     ;; Allocate memory proportional to the size of the bitmap, which
     ;; helps the GC see that we're using that much memory.
-    (define shadow (make-bytes (* width height (if b&w? 1 4))))
+    (define shadow (make-bytes (* width height 4)))
 
-    (def/public (get-width) width)
+    (def/public (get-width) (max 1 width))
-    (def/public (get-height) height)
+    (def/public (get-height) (max 1 height))
     (def/public (get-depth) (if b&w? 1 32))
     (def/public (is-color?) (not b&w?))
     (def/public (has-alpha-channel?) alpha-channel?)
@@ -227,13 +230,6 @@
     (define/public (get-bitmap-gl-context)
       #f)
 
-    (define/private (check-ok who)
-      (unless (ok?)
-        (error (method-name 'bitmap% who) "bitmap is not ok")))
-
-    (define locked 0)
-    (define/public (adjust-lock delta) (set! locked (+ locked delta)))
-
     (def/public (load-file [(make-alts path-string? input-port?) in]
                            [bitmap-file-kind-symbol? [kind 'unknown]]
                            [(make-or-false color%) [bg #f]]
@@ -242,7 +238,8 @@
       (release-bitmap-storage)
       (set!-values (s b&w?) (do-load-bitmap in kind bg complain-on-failure?))
       (set! width (if s (cairo_image_surface_get_width s) 0))
-      (set! height (if s (cairo_image_surface_get_height s) 0)))
+      (set! height (if s (cairo_image_surface_get_height s) 0))
+      (set! shadow (make-bytes (* width height 4))))
 
     (define/private (do-load-bitmap in kind bg complain-on-failure?)
       (if (path-string? in)
@@ -451,14 +448,15 @@
     (def/public (save-file [(make-alts path-string? output-port?) out]
                            [bitmap-save-kind-symbol? [kind 'unknown]]
                            [quality-integer? [quality 75]])
-      (check-ok 'save-file)
+      (and (ok?)
+           (begin
              (if alt?
                  (call-with-alt-bitmap 
                   0 0 width height
                   (lambda (bm)
                     (send bm save-file out kind quality)))
                  (do-save-file out kind quality))
-      #t)
+             #t)))
 
     (define/private (do-save-file out kind quality)
       (if (path-string? out)
@@ -560,13 +558,14 @@
 
     (def/public (ok?) (and s #t))
 
-    (define/public (get-cairo-surface) s)
+    (define/public (get-cairo-surface) (or s (get-empty-surface)))
     (define/public (get-cairo-alpha-surface)
-      (if (or b&w? alpha-channel?)
+      (or (if (or b&w? alpha-channel?)
               s
               (begin
                 (prep-alpha)
-            alpha-s)))
+                alpha-s))
+          (get-empty-surface)))
 
     (def/public (get-argb-pixels [exact-nonnegative-integer? x]
                                  [exact-nonnegative-integer? y]
@@ -578,11 +577,12 @@
         (raise-mismatch-error (method-name 'bitmap% 'get-argb-pixels)
                               "byte string is too short: "
                               bstr))
+      (when (ok?)
         (if alt?
             (call-with-alt-bitmap
              x y w h 
              (lambda (bm) (send bm get-argb-pixels 0 0 w h bstr get-alpha?)))
-          (do-get-argb-pixels x y w h bstr get-alpha?)))
+            (do-get-argb-pixels x y w h bstr get-alpha?))))
 
     (define/private (do-get-argb-pixels x y w h bstr get-alpha?)
       ;; Fill range that is beyond edge of picture:
@@ -658,6 +658,7 @@
                               "byte string is too short: "
                               bstr))
       (check-alternate 'set-argb-pixels)
+      (when (ok?)
         ;; Set pixels:
         (let-values ([(A R G B) (argb-indices)])
           (when (not set-alpha?)
@@ -701,7 +702,7 @@
                (not alpha-channel?))
           ;; Set alphas:
           (set-alphas-as-mask x y w h bstr (* 4 w) 0)])
-      (drop-alpha-s))
+        (drop-alpha-s)))
     
     (define/public (get-alphas-as-mask x y w h bstr)
       (let ([data (cairo_image_surface_get_data (if (or b&w? alpha-channel?)

collects/racket/draw/private/brush.rkt

@@ -91,10 +91,6 @@
   (def/public (get-stipple) stipple)
   (def/public (set-stipple [(make-or-false bitmap%) s]) 
     (check-immutable 'set-stipple)
-    (let ([old-s stipple])
-      (set! stipple #f)
-      (when old-s (send old-s adjust-lock -1)))
-    (when s (send s adjust-lock 1))
     (set! stipple s)))
 
 ;; ----------------------------------------

collects/racket/draw/private/pen.rkt

@@ -127,10 +127,6 @@
   (def/public (get-stipple) stipple)
   (def/public (set-stipple [(make-or-false bitmap%) s]) 
     (check-immutable 'set-stipple)
-    (let ([old-s stipple])
-      (set! stipple #f)
-      (when old-s (send old-s adjust-lock -1)))
-    (when s (send s adjust-lock 1))
     (set! stipple s)))
 
 ;; ----------------------------------------

collects/scribblings/draw/bitmap-class.scrbl

@@ -7,11 +7,6 @@ A @scheme[bitmap%] object is a pixel-based image, either
  monochrome, color, or color with an alpha channel. See also
  @racket[make-screen-bitmap] and @xmethod[canvas% make-bitmap].
 
-Sometimes, a bitmap object creation fails in a low-level manner. In
- that case, the @method[bitmap% ok?] method returns @scheme[#f], and
- the bitmap cannot be supplied to methods that consume or operate on
- bitmaps (otherwise, @|MismatchExn|).
-
 A bitmap is convertible to @racket['png-bytes] through the
 @racketmodname[file/convertible] protocol.
 
@@ -34,7 +29,7 @@ A bitmap is convertible to @racket['png-bytes] through the
                         [width exact-positive-integer?]
                         [height exact-positive-integer?]))]{
 
-The @racket[make-bitmap], @racket[make-monchrome-bitmap], and
+The @racket[make-bitmap], @racket[make-monochrome-bitmap], and
  @racket[read-bitmap] functions are preferred over using
  @racket[make-object] with @racket[bitmap%], because the functions are
  less overloaded and provide more useful defaults.
@@ -217,13 +212,13 @@ For PNG loading, if @scheme[bg-color] is not @scheme[#f], then it is
 @defmethod[(ok?)
            boolean?]{
 
-Returns @scheme[#t] if the bitmap is usable (created or changed
+Returns @scheme[#t] if the bitmap is valid in the sense that an image
- successfully). If @scheme[#f] is returned, the bitmap cannot be
+ file was loaded successfully. If @method[bitmap% ok?] returns
- supplied to methods that consume or operate on bitmaps (otherwise,
+ @racket[#f], then drawing to or from the bitmap has no effect.
- @|MismatchExn|).
 
 }
 
+
 @defmethod[(save-file [name (or/c path-string? output-port?)]
                       [kind (one-of/c 'png 'jpeg 'xbm 'xpm 'bmp)]
                       [quality (integer-in 0 100) 75])

collects/scribblings/draw/brush-class.scrbl

@@ -59,8 +59,7 @@ A brush's style is one of the following:
 
 @index['("drawing" "outlines")]{To} draw outline shapes (such as
  unfilled boxes and ellipses), use the @scheme['transparent] brush
- style. See @method[brush% set-style] for more information about
+ style.
- styles.
 
 To avoid creating multiple brushes with the same characteristics, use
  the global @scheme[brush-list%] object
@@ -136,11 +135,10 @@ Sets or removes the stipple bitmap, where @scheme[#f] removes the
  stipple. See @scheme[brush%] for information about drawing with
  stipples.
 
-A bitmap cannot be used as a stipple if it is selected into a
+If @racket[bitmap] is modified while is associated with a brush, the
- @scheme[bitmap-dc%] object; if the given bitmap is selected into a
+ effect on the brush is unspecified. A brush cannot be modified if it
- @scheme[bitmap-dc%] object, @|MismatchExn|. A brush cannot be
+ was obtained from a @scheme[brush-list%] or while it is selected into
- modified if it was obtained from a @scheme[brush-list%] or while it
+ a drawing context.
- is selected into a drawing context.
 
 }
 

collects/scribblings/draw/pen-class.scrbl

@@ -162,16 +162,15 @@ A pen cannot be modified if it was obtained from a
 
 }
 
-@defmethod[(set-stipple [stipple (or/c (is-a?/c bitmap%) #f)])
+@defmethod[(set-stipple [bitmap (or/c (is-a?/c bitmap%) #f)])
            void?]{
 
 Sets the pen stipple bitmap, where @scheme[#f] turns off the stipple bitmap.
 
-A bitmap cannot be used as a stipple if it is selected into a
+If @racket[bitmap] is modified while is associated with a pen, the
- @scheme[bitmap-dc%] object; if the given bitmap is selected into a
+ effect on the pen is unspecified. A pen cannot be modified if it was
- @scheme[bitmap-dc%] object, @|MismatchExn|. A pen cannot be modified
+ obtained from a @scheme[pen-list%] or while it is selected into a
- if it was obtained from a @scheme[pen-list%] or while it is selected
+ drawing context.
- into a drawing context.
 
 }
 

collects/scribblings/gui/blurbs.rkt

@@ -40,25 +40,22 @@
     @elem{If @litchar{&} occurs in @|where|@|detail|, it 
  is specially parsed as for @scheme[button%].})
 
-  (define (bitmapuseinfo pre what thing then detail)
+  (define (bitmapuseinfo pre what thing and the)
-   @elem{@|pre| @|what| is @|thing|, @|then| the bitmap@|detail|
+   @elem{@|pre| @|what| is @|thing|,@|and| if @|the|
- must be valid (see @xmethod[bitmap% ok?]) and not installed
- in a @scheme[bitmap-dc%] object; otherwise, @|MismatchExn|. If the
  bitmap has a mask (see @xmethod[bitmap% get-loaded-mask])
  that is the same size as the bitmap, then the mask is used for the
- label; furthermore, in contrast to the limitations of
+ label. Modifying a bitmap while it is used as a label has
- @xmethod[dc<%> draw-bitmap], non-monochrome label masks work
+ an unspecified effect on the displayed label.})
- consistently on all platforms.})
 
   (define-syntax bitmaplabeluse
    (syntax-rules ()
-     [(_ id) @bitmapuseinfo["If" (scheme id) "a bitmap" "then" ""]]))
+     [(_ id) @bitmapuseinfo["If" (scheme id) "a bitmap" " and" "the"]]))
   (define-syntax bitmaplabelusearray
    (syntax-rules ()
-     [(_ id) @bitmapuseinfo["If" (scheme id) "a list of bitmaps" "then" "s"]]))
+     [(_ id) @bitmapuseinfo["If" (scheme id) "a list of bitmaps" " and" "a"]]))
   (define-syntax bitmaplabeluseisbm
     (syntax-rules ()
-      [(_ id) @bitmapuseinfo["Since" (scheme id) "a bitmap" "" ""]]))
+      [(_ id) @bitmapuseinfo["Since" (scheme id) "a bitmap" "" "the"]]))
   
   (define bitmapiforiglabel
     @elem{The bitmap label is installed only

collects/scribblings/gui/image-snip-class.scrbl

@@ -50,10 +50,6 @@ Returns the bitmap that is displayed by the snip, whether set through
  @method[image-snip% set-bitmap] or @method[image-snip% load-file]. If
  no bitmap is displayed, the result is @racket[#f].
 
-The returned bitmap cannot be selected into a @racket[bitmap-dc%] as
- long as it belongs to the snip, but it can be used as a pen or
- brush stipple.
-
 }
 
 @defmethod[(get-bitmap-mask)
@@ -63,10 +59,6 @@ Returns the mask bitmap that is used for displaying by the snip, if
  one was installed with @method[image-snip% set-bitmap].  If no mask
  is used, the result is @racket[#f].
 
-The returned bitmap cannot be selected into a @racket[bitmap-dc%] as
- long as it belongs to the snip, but it can be used as a pen or
- brush stipple.
-
 }
 
 @defmethod[(get-filename [relative-path (or/c (box/c any/c) #f) #f])

collects/scribblings/gui/message-class.scrbl

@@ -5,7 +5,7 @@
 
 A message control is a static line of text or a static bitmap. The
  text or bitmap corresponds to the message's label (see
-@method[window<%> set-label]).
+@method[message% set-label]).
 
 
 @defconstructor[([label (or/c label-string? (is-a?/c bitmap%) 
@@ -28,7 +28,7 @@ Creates a string or bitmap message initially showing @scheme[label].
  @indexed-scheme['caution], or @indexed-scheme['stop] symbol for
  @scheme[label] indicates an icon; @scheme['app] is the application
  icon (Windows and Mac OS X) or a generic ``info'' icon (X),
- @scheme['caution] is a caution-sign icon, and @scheme['stop] a
+ @scheme['caution] is a caution-sign icon, and @scheme['stop] is a
  stop-sign icon.
 
 @labelsimplestripped[(scheme label) @elem{message}]

collects/scribblings/gui/text-class.scrbl

@@ -1799,10 +1799,6 @@ If @scheme[bitmap] is @scheme[#f], no autowrap indicator is drawn
  (this is the default). The previously used bitmap (possibly
  @scheme[#f]) is returned.
 
-The bitmap will not be modified. It may be selected into a
- @scheme[bitmap-dc%] object, but it will be selected out if this
- method is called again.
-
 Setting the bitmap is disallowed when the editor is internally locked
  for reflowing (see also @|lockdiscuss|).