Merge branch 'pre-repaint-queue'

18 files changed, 160 insertions, 166 deletions

diff --git a/Backends/CLX/package.lisp b/Backends/CLX/package.lisp
index c189aa4b..80e291a7 100644
--- a/Backends/CLX/package.lisp
+++ b/Backends/CLX/package.lisp
@@ -31,7 +31,6 @@
                 #:with-transformed-positions
                 #:with-transformed-distance
                 #:with-transformed-angles
-                #:with-medium-options
                 #:line-style-effective-thickness
                 #:line-style-effective-dashes
                 ;; designs
diff --git a/Core/clim-core/panes/construction.lisp b/Core/clim-core/panes/construction.lisp
index 9183fd68..b5673c87 100644
--- a/Core/clim-core/panes/construction.lisp
+++ b/Core/clim-core/panes/construction.lisp
@@ -201,8 +201,8 @@ returned or error is signaled depending on the argument ERRORP.")
                       always-repaint-background-mixin
                       mouse-wheel-scroll-mixin
                       permanent-medium-sheet-output-mixin
-                      clim-repainting-mixin
-                      clim-sheet-input-mixin
+                      immediate-repainting-mixin
+                      standard-sheet-input-mixin
                       sheet-transformation-mixin
                       layout-protocol-mixin
                       pane
diff --git a/Core/clim-core/system/encapsulate.lisp b/Core/clim-core/system/encapsulate.lisp
index 96c74181..290679e7 100644
--- a/Core/clim-core/system/encapsulate.lisp
+++ b/Core/clim-core/system/encapsulate.lisp
@@ -396,14 +396,10 @@
 (def-stream-method (setf medium-buffering-output-p)
     (buffered-p (stream standard-encapsulating-stream)))
 
-(defmethod invoke-with-drawing-options ((medium standard-encapsulating-stream)
-                                        continuation &rest drawing-options)
-  (flet ((trampoline (old-medium)
-           (declare (ignore old-medium))
-           (funcall continuation medium)))
-    (declare (dynamic-extent #'trampoline))
-    (apply #'invoke-with-drawing-options
-           (slot-value medium 'stream) #'trampoline drawing-options)))
+(defmethod invoke-with-drawing-options
+    ((self standard-encapsulating-stream) cont &rest opts)
+  (with-drawing-options* ((encapsulating-stream-stream self) opts)
+    (funcall cont self)))
 
 ;;; Extended Input Streams
 
diff --git a/Core/drawing/graphics.lisp b/Core/drawing/graphics.lisp
index a241939f..f02b8933 100644
--- a/Core/drawing/graphics.lisp
+++ b/Core/drawing/graphics.lisp
@@ -113,49 +113,37 @@
         (with-clipping-region (orig-medium clipping-region)
           (funcall func orig-medium))))))
 
-;;; The generic function DO-GRAPHICS-WITH-OPTIONS is internal to the
-;;; CLIM-INTERNALS package.  It is used in the expansion of the macro
-;;; WITH-MEDIUM-OPTIONS.
-(defgeneric do-graphics-with-options (medium function &rest options)
-  (:method (medium func &rest options)
-    (declare (ignore options))
-    (maybe-funcall func medium))
-  (:method ((medium medium) func &rest options)
-    (let ((*foreground-ink* (medium-foreground medium))
-          (*background-ink* (medium-background medium)))
-      (apply #'do-graphics-with-options-internal medium medium func options))))
-
-(defmacro with-medium-options ((medium args) &body body)
-  `(flet ((graphics-op (medium)
-            (declare (ignorable medium))
-            ,@body))
-     (declare (dynamic-extent #'graphics-op))
-     (apply #'do-graphics-with-options ,medium #'graphics-op ,args)))
-
 (defmacro with-drawing-options ((medium &rest drawing-options) &body body)
   (with-stream-designator (medium '*standard-output*)
     (with-gensyms (gcontinuation cont-arg)
       `(flet ((,gcontinuation (,cont-arg)
                 (declare (ignore ,cont-arg))
                 ,@body))
-         (declare (dynamic-extent #',gcontinuation))
+         (declare (dynamic-extent (function ,gcontinuation)))
          (invoke-with-drawing-options
-          ,medium #',gcontinuation ,@drawing-options)))))
-
-(defmethod invoke-with-drawing-options ((medium medium) continuation
-                                        &rest drawing-options
-                                        &key ink transformation clipping-region
-                                        line-style text-style
-                                        &allow-other-keys)
-  (declare (ignore ink transformation clipping-region line-style text-style))
-  (with-medium-options (medium drawing-options)
-    (funcall continuation medium)))
+          ,medium (function ,gcontinuation) ,@drawing-options)))))
+
+;;; Same as the above, but applies args..
+(defmacro with-drawing-options* ((medium drawing-options) &body body)
+  (with-stream-designator (medium '*standard-output*)
+    (with-gensyms (gcontinuation cont-arg)
+      `(flet ((,gcontinuation (,cont-arg)
+                (declare (ignore ,cont-arg))
+                ,@body))
+         (declare (dynamic-extent #',gcontinuation))
+         (apply #'invoke-with-drawing-options
+                ,medium (function ,gcontinuation) ,drawing-options)))))
 
 ;;; Compatibility with real CLIM
-(defmethod invoke-with-drawing-options
-    (medium continuation &rest drawing-options)
-  (declare (ignore drawing-options))
-  (funcall continuation medium))
+(defmethod invoke-with-drawing-options (self cont &rest opts)
+  (declare (ignore opts))
+  (funcall cont self))
+
+(defmethod invoke-with-drawing-options ((self medium) cont &rest opts)
+  (let ((*foreground-ink* (medium-foreground self))
+        (*background-ink* (medium-background self)))
+    (apply #'do-graphics-with-options-internal
+           self self cont opts)))
 
 (defmethod invoke-with-identity-transformation
     ((medium medium) continuation)
@@ -209,50 +197,50 @@
 
 (defmethod draw-design (medium (design point)
                         &rest options &key &allow-other-keys)
-  (with-medium-options (medium options)
+  (with-drawing-options* (medium options)
     (medium-draw-point* medium (point-x design) (point-y design))))
 
 (defmethod draw-design (medium (design polyline)
                         &rest options &key &allow-other-keys)
-  (with-medium-options (medium options)
+  (with-drawing-options* (medium options)
     (let ((coords (expand-point-seq (polygon-points design)))
           (closed (polyline-closed design)))
      (medium-draw-polygon* medium coords closed nil))))
 
 (defmethod draw-design (medium (design polygon)
                         &rest options &key (filled t) &allow-other-keys)
-  (with-medium-options (medium options)
+  (with-drawing-options* (medium options)
     (let ((coords (expand-point-seq (polygon-points design))))
       (medium-draw-polygon* medium coords t filled))))
 
 (defmethod draw-design (medium (design polybezier)
                         &rest options &key &allow-other-keys)
-  (with-medium-options (medium options)
+  (with-drawing-options* (medium options)
     (let ((coords (expand-point-seq (bezigon-points design))))
       (medium-draw-bezigon* medium coords nil nil))))
 
 (defmethod draw-design (medium (design bezigon)
                         &rest options &key (closed t) (filled t) &allow-other-keys)
-  (with-medium-options (medium options)
+  (with-drawing-options* (medium options)
     (let ((coords (expand-point-seq (bezigon-points design))))
      (medium-draw-bezigon* medium coords closed filled))))
 
 (defmethod draw-design (medium (design line)
                         &rest options &key &allow-other-keys)
-  (with-medium-options (medium options)
+  (with-drawing-options* (medium options)
     (multiple-value-bind (x1 y1) (line-start-point* design)
       (multiple-value-bind (x2 y2) (line-end-point* design)
         (medium-draw-line* medium x1 y1 x2 y2)))))
 
 (defmethod draw-design (medium (design rectangle)
                         &rest options &key (filled t) &allow-other-keys)
-  (with-medium-options (medium options)
+  (with-drawing-options* (medium options)
     (multiple-value-bind (x1 y1 x2 y2) (rectangle-edges* design)
       (medium-draw-rectangle* medium x1 y1 x2 y2 filled))))
 
 (defmethod draw-design (medium (design ellipse)
                         &rest options &key (filled t) &allow-other-keys)
-  (with-medium-options (medium options)
+  (with-drawing-options* (medium options)
     (multiple-value-bind (cx cy) (ellipse-center-point* design)
       (multiple-value-bind (r1x r1y r2x r2y) (ellipse-radii design)
         (let ((sa (or (ellipse-start-angle design) 0.0))
@@ -261,7 +249,7 @@
 
 (defmethod draw-design (medium (design elliptical-arc)
                         &rest options &key &allow-other-keys)
-  (with-medium-options (medium options)
+  (with-drawing-options* (medium options)
     (multiple-value-bind (cx cy) (ellipse-center-point* design)
       (multiple-value-bind (r1x r1y r2x r2y) (ellipse-radii design)
         (let ((sa (or (ellipse-start-angle design) 0.0))
diff --git a/Core/drawing/medium.lisp b/Core/drawing/medium.lisp
index 777d4035..cae6c948 100644
--- a/Core/drawing/medium.lisp
+++ b/Core/drawing/medium.lisp
@@ -78,7 +78,37 @@
                                  gs-line-style-mixin
                                  gs-text-style-mixin
                                  gs-layout-mixin)
-  ())
+  ((transformation
+    :type transformation
+    :initarg :transformation
+    :initform +identity-transformation+
+    :accessor medium-transformation)
+   (clipping-region
+    :type region
+    :initarg :clipping-region
+    :initform +everywhere+
+    :documentation "Clipping region in the SHEET coordinates.")
+   (ink
+    :initarg :ink
+    :initform +foreground-ink+
+    :accessor medium-ink)
+   (line-style
+    :initarg :line-style
+    :initform (make-line-style)
+    :accessor medium-line-style)
+   (text-style
+    :initarg :text-style
+    :initform *default-text-style*
+    :accessor medium-text-style
+    :type text-style)
+   (line-direction
+    :initarg :line-direction
+    :initform :left-to-right
+    :accessor medium-line-direction)
+   (page-direction
+    :initarg :page-direction
+    :initform :top-to-bottom
+    :accessor medium-page-direction)))
 
 (defmethod (setf graphics-state) ((new-gs graphics-state) (gs graphics-state))
   #+(or) "This is a no-op, but :after methods don't work without a primary method.")
@@ -98,34 +128,11 @@
   ;; in basic-medium makes hardware-based transformations hard. -- jd 2018-03-06
   ())
 
-(defclass basic-medium (transform-coordinates-mixin complete-medium-state
-                        multiline-medium-mixin medium)
-  (;; Graphics state slots - names must coincide with complete-medium-state.
-   (transformation :type transformation
-                   :initarg :transformation
-                   :initform +identity-transformation+
-                   :accessor medium-transformation)
-   (clipping-region :type region
-                    :initarg :clipping-region
-                    :initform +everywhere+
-                    :documentation "Clipping region in the SHEET coordinates.")
-   (ink :initarg :ink
-        :initform +foreground-ink+
-        :accessor medium-ink)
-   (line-style :initarg :line-style
-               :initform (make-line-style)
-               :accessor medium-line-style)
-   (text-style :initarg :text-style
-               :initform *default-text-style*
-               :accessor medium-text-style
-               :type text-style)
-   (line-direction :initarg :line-direction
-                   :initform :left-to-right
-                   :accessor medium-line-direction)
-   (page-direction :initarg :page-direction
-                   :initform :top-to-bottom
-                   :accessor medium-page-direction)
-   ;; Default values
+(defclass basic-medium (transform-coordinates-mixin
+                        multiline-medium-mixin
+                        complete-medium-state
+                        medium)
+  (;; Default values
    (foreground :initarg :foreground
                :initform +black+
                :accessor medium-foreground
@@ -139,9 +146,9 @@
                        :accessor medium-default-text-style
                        :type text-style)
    (sheet :initarg :sheet
-          :initform nil                 ; this means that medium is not linked to a sheet
+          :initform nil ;; NIL means that medium is not linked to a sheet
           :reader medium-sheet
-          :writer (setf %medium-sheet) )
+          :writer (setf %medium-sheet))
    (port :initarg :port
          :accessor port)
    (drawable :initform nil
diff --git a/Core/drawing/protocol.lisp b/Core/drawing/protocol.lisp
index 57b1a020..ddd7d52a 100644
--- a/Core/drawing/protocol.lisp
+++ b/Core/drawing/protocol.lisp
@@ -65,8 +65,9 @@
 (defgeneric (setf graphics-state) (new-value graphics-state))
 
 ;;; 10.2 Drawing Option Binding Forms
-(pledge :macro with-medium-options ((medium args) &body body))
-(pledge :macro with-drawing-options ((medium &rest drawing-options &key ink transformation clipping-region line-style text-style &allow-other-keys) &body body))
+(pledge :macro with-drawing-options ((medium &rest drawing-options) &body body))
+(pledge :macro with-drawing-options* ((medium args) &body body))
+
 (defgeneric invoke-with-drawing-options (medium cont &rest drawing-options &key &allow-other-keys))
 
 ;;; 10.2.1 Transformation "Convenience" Forms
@@ -346,7 +347,7 @@ for a dashed line, rendered on MEDIUM with the style LINE-STYLE."))
 (declfun design-ink* (design x y))
 (defgeneric design-equalp (design1 design2))
 (defgeneric draw-design (medium design &key ink filled clipping-region transformation line-style line-thickness line-unit line-dashes line-joint-shape line-cap-shape text-style text-family text-face text-size))
-(declfun draw-pattern* (medium pattern x y &key clipping-region transformation))
+(declfun draw-pattern* (medium pattern x y &key &allow-other-keys))
 
 ;;; 14.7 Design Protocol
 
diff --git a/Core/extended-output/output-record.lisp b/Core/extended-output/output-record.lisp
index 563d2bc7..9d4562ae 100644
--- a/Core/extended-output/output-record.lisp
+++ b/Core/extended-output/output-record.lisp
@@ -374,7 +374,7 @@ the associated sheet can be determined."
   self)
 
 (defmethod draw-design (medium (self basic-output-record) &rest drawing-options)
-  (with-medium-options (medium drawing-options)
+  (with-drawing-options* (medium drawing-options)
     (replay-output-record self medium)))
 
 
@@ -1046,7 +1046,7 @@ the associated sheet can be determined."
                                                   (x-offset 0) (y-offset 0))
                  (declare (ignore region))
                  (with-slots (,@slot-names) record
-                   (let ((,medium (sheet-medium stream)))
+                   (with-sheet-medium (,medium stream)
                      ;; The medium graphics state is set up in :around methods.
                      (with-translation (,medium x-offset y-offset)
                        (,method-name ,medium ,@arg-names)))))))))))
@@ -1542,15 +1542,15 @@ the associated sheet can be determined."
      &optional region (x-offset 0) (y-offset 0))
   (declare (ignore region))
   (with-identity-transformation (stream)
-   (with-translation (stream x-offset y-offset)
-     (let ((rect (copy-bounding-rectangle record))
-           (ink1 (compose-in +blue+ (make-opacity .1)))
-           (ink2 +black+)
-           (ink3 (compose-in +black+ (make-opacity .5))))
-       (draw-design stream rect :filled t :ink ink1)
-       (draw-design stream rect :filled nil :ink ink2 :line-thickness .5)
-       (with-bounding-rectangle* (:center-x cx :center-y cy) rect
-         (draw-point* stream cx cy :line-thickness 10 :ink ink3))))))
+    (with-translation (stream x-offset y-offset)
+      (let ((rect (copy-bounding-rectangle record))
+            (ink1 (compose-in +blue+ (make-opacity .1)))
+            (ink2 +black+)
+            (ink3 (compose-in +black+ (make-opacity .5))))
+        (draw-design stream rect :filled t :ink ink1)
+        (draw-design stream rect :filled nil :ink ink2 :line-thickness .5)
+        (with-bounding-rectangle* (:center-x cx :center-y cy) rect
+          (draw-point* stream cx cy :line-thickness 10 :ink ink3))))))
 
 (defrecord-predicate draw-text-output-record
     (string start end
diff --git a/Core/extended-output/text-formatting.lisp b/Core/extended-output/text-formatting.lisp
index 4ec3d4cb..aa99e3b4 100644
--- a/Core/extended-output/text-formatting.lisp
+++ b/Core/extended-output/text-formatting.lisp
@@ -12,9 +12,7 @@
 
 (in-package #:clim-internals)
 
-;;; Mixin is used to store text-style and ink when filling-output it is invoked.
-
-(defclass filling-output-mixin (gs-ink-mixin gs-text-style-mixin)
+(defclass filling-output-mixin ()
   ((lbs :accessor line-break-strategy :initarg :line-break-strategy
         :documentation "T for a default word wrap or a list of break characters.")
    (alb :accessor after-line-break :initarg :after-line-break
diff --git a/Core/geometry/transforms.lisp b/Core/geometry/transforms.lisp
index 7c97b5aa..6f6234a9 100644
--- a/Core/geometry/transforms.lisp
+++ b/Core/geometry/transforms.lisp
@@ -123,7 +123,7 @@ transformation protocol."))
 (defmethod print-object ((transformation standard-hairy-transformation) sink)
   (maybe-print-readably (transformation sink)
     (print-unreadable-object (transformation sink :identity nil :type t)
-      (apply #'format sink "~S ~S ~S ~S ~S ~S"
+      (apply #'format sink "~,2f ~,2f ~,2f ~,2f ~,2f ~,2f"
              (multiple-value-list (get-transformation transformation))))))
 
 (defmethod print-object ((transformation standard-transformation) sink)
diff --git a/Core/windowing/input.lisp b/Core/windowing/input.lisp
index 651650f0..a80646c2 100644
--- a/Core/windowing/input.lisp
+++ b/Core/windowing/input.lisp
@@ -175,8 +175,3 @@
                                  &key (timeout nil) (wait-function nil))
   (event-listen-or-wait (delegate-sheet-delegate sheet)
                         :timeout timeout :wait-function wait-function))
-
-;;; Class actually used by panes.
-
-(defclass clim-sheet-input-mixin (standard-sheet-input-mixin)
-  ())
diff --git a/Core/windowing/output.lisp b/Core/windowing/output.lisp
index 3da9d2b8..f739cd10 100644
--- a/Core/windowing/output.lisp
+++ b/Core/windowing/output.lisp
@@ -51,6 +51,7 @@
   (frob medium-page-direction medium)
   (frob (setf medium-page-direction) page-direction medium)
   (frob medium-current-text-style medium)
+  (frob medium-merged-text-style medium)
   (frob medium-beep medium)
   (frob medium-buffering-output-p medium))
 
@@ -85,10 +86,9 @@
 (defmacro with-sheet-medium ((medium sheet) &body body)
   (check-type medium symbol)
   (let ((fn (gensym)))
-    `(labels ((,fn (,medium)
-                ,(declare-ignorable-form* medium)
-                ,@body))
-       (declare (dynamic-extent (function ,fn)))
+    `(flet ((,fn (,medium)
+              ,(declare-ignorable-form* medium)
+              ,@body))
        (invoke-with-sheet-medium (function ,fn) ,sheet))))
 
 (defmethod invoke-with-sheet-medium
@@ -118,10 +118,9 @@
   (let ((fn (gensym))
         (medium-var (if (symbolp medium) medium (gensym))))
     (once-only (sheet)
-      `(labels ((,fn (,medium-var)
-                  ,(declare-ignorable-form* medium-var)
-                  ,@body))
-         (declare (dynamic-extent (function ,fn)))
+      `(flet ((,fn (,medium-var)
+                ,(declare-ignorable-form* medium-var)
+                ,@body))
          (if-let ((,medium-var (sheet-medium ,sheet)))
            (,fn ,medium-var)
            (invoke-with-sheet-medium-bound (function ,fn) ,medium ,sheet))))))
@@ -141,16 +140,13 @@
            (degraft-medium medium (port medium) sheet)))
         (t (error "~s is not a medium." medium))))
 
-(defmethod do-graphics-with-options ((sheet sheet) func &rest options)
-  (with-sheet-medium (medium sheet)
+(defmethod invoke-with-drawing-options
+    ((self sheet) cont &rest opts)
+  (with-sheet-medium (medium self)
     (let ((*foreground-ink* (medium-foreground medium))
           (*background-ink* (medium-background medium)))
-      (apply #'do-graphics-with-options-internal medium sheet func options))))
-
-(defmethod invoke-with-drawing-options
-    ((sheet sheet) continuation &rest drawing-options)
-  (with-medium-options (sheet drawing-options)
-    (funcall continuation sheet)))
+      (apply #'do-graphics-with-options-internal
+             medium self cont opts))))
 
 (defmethod invoke-with-clipping-region ((sheet sheet) cont region)
   (with-sheet-medium (medium sheet)
@@ -170,84 +166,84 @@
     `(defun ,name (,sheet ,@position-args
                    &rest ,medium-options &key ,@extra-keys &allow-other-keys)
        (with-stream-designator (,sheet *standard-output*)
-         (with-medium-options (,sheet ,medium-options)
+         (with-drawing-options* (,sheet ,medium-options)
            ,@body)))))
 
 (define-drawing-function (draw-point sheet point) ()
   (multiple-value-bind (x y) (point-position point)
-    (medium-draw-point* medium x y)))
+    (medium-draw-point* sheet x y)))
 
 (define-drawing-function (draw-point* sheet x y) ()
-  (medium-draw-point* medium x y))
+  (medium-draw-point* sheet x y))
 
 (define-drawing-function (draw-points sheet point-seq) ()
-  (medium-draw-points* medium (expand-point-seq point-seq)))
+  (medium-draw-points* sheet (expand-point-seq point-seq)))
 
 (define-drawing-function (draw-points* sheet coord-seq) ()
-  (medium-draw-points* medium coord-seq))
+  (medium-draw-points* sheet coord-seq))
 
 (define-drawing-function (draw-line sheet point1 point2) ()
   (multiple-value-bind (x1 y1) (point-position point1)
     (multiple-value-bind (x2 y2) (point-position point2)
-      (medium-draw-line* medium x1 y1 x2 y2))))
+      (medium-draw-line* sheet x1 y1 x2 y2))))
 
 (define-drawing-function (draw-line* sheet x1 y1 x2 y2) ()
-  (medium-draw-line* medium x1 y1 x2 y2))
+  (medium-draw-line* sheet x1 y1 x2 y2))
 
 (define-drawing-function (draw-lines sheet point-seq) ()
-  (medium-draw-lines* medium (expand-point-seq point-seq)))
+  (medium-draw-lines* sheet (expand-point-seq point-seq)))
 
 (define-drawing-function (draw-lines* sheet coord-seq) ()
-  (medium-draw-lines* medium coord-seq))
+  (medium-draw-lines* sheet coord-seq))
 
 (define-drawing-function (draw-polygon sheet point-seq)
     ((filled t)
      (closed t))
-  (medium-draw-polygon* medium (expand-point-seq point-seq) closed filled))
+  (medium-draw-polygon* sheet (expand-point-seq point-seq) closed filled))
 
 (define-drawing-function (draw-polygon* sheet coord-seq)
     ((filled t)
      (closed t))
-  (medium-draw-polygon* medium coord-seq closed filled))
+  (medium-draw-polygon* sheet coord-seq closed filled))
 
 (define-drawing-function (draw-bezigon sheet point-seq)
     ((filled t)
      (closed t))
-  (medium-draw-bezigon* medium (expand-point-seq point-seq) closed filled))
+  (medium-draw-bezigon* sheet (expand-point-seq point-seq) closed filled))
 
 (define-drawing-function (draw-bezigon* sheet coord-seq)
     ((filled t)
      (closed t))
-  (medium-draw-bezigon* medium coord-seq closed filled))
+  (medium-draw-bezigon* sheet coord-seq closed filled))
 
 (define-drawing-function (draw-rectangle sheet point1 point2)
     ((filled t))
   (multiple-value-bind (x1 y1) (point-position point1)
     (multiple-value-bind (x2 y2) (point-position point2)
-      (medium-draw-rectangle* medium x1 y1 x2 y2 filled))))
+      (medium-draw-rectangle* sheet x1 y1 x2 y2 filled))))
 
 (define-drawing-function (draw-rectangle* sheet x1 y1 x2 y2)
     ((filled t))
-  (medium-draw-rectangle* medium x1 y1 x2 y2 filled))
+  (medium-draw-rectangle* sheet x1 y1 x2 y2 filled))
 
 (define-drawing-function (draw-rectangles sheet points)
     ((filled t))
   (loop for point in points
         nconcing (multiple-value-list (point-position point))
           into position-seq
-        finally (medium-draw-rectangles* medium position-seq filled)))
+        finally (medium-draw-rectangles* sheet position-seq filled)))
 
 (define-drawing-function (draw-rectangles* sheet position-seq)
     ((filled t))
-  (medium-draw-rectangles* medium position-seq filled))
+  (medium-draw-rectangles* sheet position-seq filled))
 
 (define-drawing-function (draw-triangle sheet p1 p2 p3)
     ((filled t))
-  (medium-draw-polygon* medium (expand-point-seq (list p1 p2 p3)) t filled))
+  (medium-draw-polygon* sheet (expand-point-seq (list p1 p2 p3)) t filled))
 
 (define-drawing-function (draw-triangle* sheet x1 y1 x2 y2 x3 y3)
     ((filled t))
-  (medium-draw-polygon* medium (list x1 y1 x2 y2 x3 y3) t filled))
+  (medium-draw-polygon* sheet (list x1 y1 x2 y2 x3 y3) t filled))
 
 (define-drawing-function (draw-ellipse sheet center-point
                                        radius-1-dx radius-1-dy radius-2-dx radius-2-dy)
@@ -257,7 +253,7 @@
   (multiple-value-setq (start-angle end-angle)
     (normalize-angle* start-angle end-angle))
   (multiple-value-bind (center-x center-y) (point-position center-point)
-    (medium-draw-ellipse* medium
+    (medium-draw-ellipse* sheet
                           center-x center-y
                           radius-1-dx radius-1-dy radius-2-dx radius-2-dy
                           start-angle end-angle filled)))
@@ -267,7 +263,7 @@
     ((filled t)
      (start-angle 0.0)
      (end-angle (* 2.0 pi)))
-  (medium-draw-ellipse* medium
+  (medium-draw-ellipse* sheet
                         center-x center-y
                         radius-1-dx radius-1-dy radius-2-dx radius-2-dy
                         start-angle end-angle filled))
@@ -277,7 +273,7 @@
      (start-angle 0.0)
      (end-angle (* 2.0 pi)))
   (multiple-value-bind (center-x center-y) (point-position center-point)
-    (medium-draw-ellipse* medium
+    (medium-draw-ellipse* sheet
                           center-x center-y
                           radius 0 0 radius
                           start-angle end-angle filled)))
@@ -286,7 +282,7 @@
     ((filled t)
      (start-angle 0.0)
      (end-angle (* 2.0 pi)))
-  (medium-draw-ellipse* medium
+  (medium-draw-ellipse* sheet
                         center-x center-y
                         radius 0 0 radius
                         start-angle end-angle filled))
@@ -303,7 +299,7 @@
         (if toward-point-p
             (point-position toward-point)
             (values (1+ x) y))
-      (medium-draw-text* medium string x y
+      (medium-draw-text* sheet string x y
                          start end
                          align-x align-y
                          toward-x toward-y transform-glyphs))))
@@ -316,7 +312,7 @@
      (toward-x (1+ x))
      (toward-y y)
      transform-glyphs)
-  (medium-draw-text* medium string x y
+  (medium-draw-text* sheet string x y
                      start end
                      align-x align-y
                      toward-x toward-y transform-glyphs))
@@ -324,7 +320,7 @@
 (define-drawing-function (draw-pattern* sheet pattern x y)
     ()
   (check-type pattern pattern)
-  (medium-draw-pattern* medium pattern x y))
+  (medium-draw-pattern* sheet pattern x y))
 
 (defun draw-arrow (sheet point-1 point-2
                    &rest drawing-options
@@ -342,7 +338,7 @@
                          (head-filled nil) angle
                     &allow-other-keys)
   (with-stream-designator (sheet *standard-output*)
-    (with-medium-options (sheet drawing-options)
+    (with-drawing-options* (sheet drawing-options)
       (with-translation (sheet x2 y2)
         (unless angle
           (let ((dx (- x1 x2))
@@ -418,7 +414,7 @@
   (check-type x-radius (real 0))
   (check-type y-radius (real 0))
   (with-stream-designator (sheet *standard-output*)
-    (with-medium-options (sheet drawing-options)
+    (with-drawing-options* (sheet drawing-options)
       (if (or (coordinate= x-radius 0) (coordinate= y-radius 0))
           (draw-circle* sheet center-x center-y (max x-radius y-radius)
                         :filled filled)
diff --git a/Core/windowing/protocol.lisp b/Core/windowing/protocol.lisp
index 0946bbd6..69cbd264 100644
--- a/Core/windowing/protocol.lisp
+++ b/Core/windowing/protocol.lisp
@@ -119,6 +119,9 @@ call depends on a port."))
 (defgeneric queue-read (queue)
   (:documentation "Reads one item from the queue (blocking)."))
 
+(defgeneric queue-drain (queue)
+  (:documentation "Reads all elements from the queue and empties it."))
+
 (defgeneric queue-read-no-hang (queue)
   (:documentation "Reads one item from the queue. If queue is empty returns NIL."))
 
@@ -166,7 +169,6 @@ is not empty or none of the above happened before a timeout.
 (pledge :mixin sheet-mute-input-mixin)
 (pledge :mixin delegate-sheet-input-mixin)
 (define-accessor delegate-sheet-delegate (new-value instance))
-(pledge :mixin clim-sheet-input-mixin)
 
 ;;; 8.2 Standard Device Events
 (define-protocol-class event nil nil (:default-initargs :timestamp nil))
@@ -281,7 +283,6 @@ and button states of the pointer."))
 (pledge :mixin sheet-mute-repainting-mixin)
 (pledge :mixin always-repaint-background-mixin)
 (pledge :mixin never-repaint-background-mixin)
-(pledge :mixin clim-repainting-mixin)
 
 ;;; 8.5 Sheet Notification Protocol
 
diff --git a/Core/windowing/queues.lisp b/Core/windowing/queues.lisp
index 750d700e..f311df67 100644
--- a/Core/windowing/queues.lisp
+++ b/Core/windowing/queues.lisp
@@ -122,6 +122,13 @@ use condition-variables nor locks."))
       (setf (queue-tail queue) nil))
     res))
 
+(defun %queue-drain (queue)
+  (let ((res (queue-head queue)))
+    (unless (null res)
+      (setf (queue-head queue) nil)
+      (setf (queue-tail queue) nil))
+    res))
+
 (defmethod queue-read ((queue simple-queue))
   (do-port-force-output queue)
   (check-schedule queue)
@@ -136,6 +143,11 @@ use condition-variables nor locks."))
          (process-next-event port))
        (check-schedule queue)))
 
+(defmethod queue-drain ((queue simple-queue))
+  (do-port-force-output queue)
+  (check-schedule queue)
+  (%queue-drain queue))
+
 (defmethod queue-read-no-hang ((queue simple-queue))
   (do-port-force-output queue)
   (check-schedule queue)
@@ -361,6 +373,12 @@ use condition-variables nor locks."))
                   (decay (compute-decay nil schedule-time)))
              (condition-wait cv lock decay)))))))
 
+(defmethod queue-drain ((queue simple-queue))
+  (do-port-force-output queue)
+  (check-schedule queue)
+  (with-lock-held ((queue-lock queue))
+    (%queue-drain queue)))
+
 (defmethod queue-read-no-hang ((queue concurrent-queue))
   (do-port-force-output queue)
   (check-schedule queue)
diff --git a/Core/windowing/repaint.lisp b/Core/windowing/repaint.lisp
index 249ffc5c..182d1b05 100644
--- a/Core/windowing/repaint.lisp
+++ b/Core/windowing/repaint.lisp
@@ -146,12 +146,6 @@
   (declare (ignore sheet region))
   (values))
 
-(defclass clim-repainting-mixin (immediate-repainting-mixin)
-  ;; (#+clim-mp standard-repainting-mixin #-clim-mp immediate-repainting-mixin)
-  ()
-  (:documentation "Internal class that implements the repainting protocol."))
-
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; No Standard.
diff --git a/Core/windowing/sheets.lisp b/Core/windowing/sheets.lisp
index 945c22eb..374a2074 100644
--- a/Core/windowing/sheets.lisp
+++ b/Core/windowing/sheets.lisp
@@ -610,9 +610,9 @@
   +identity-transformation+)
 
 (defclass sheet-transformation-mixin ()
-  ((transformation :initform +identity-transformation+
-                   :initarg :transformation
-                   :accessor sheet-transformation)))
+  ((sheet-transformation :initform +identity-transformation+
+                         :initarg :transformation
+                         :accessor sheet-transformation)))
 
 (defclass sheet-translation-mixin (sheet-transformation-mixin)
   ())
diff --git a/Examples/text-size-util.lisp b/Examples/text-size-util.lisp
index 461421b9..a53b79f3 100644
--- a/Examples/text-size-util.lisp
+++ b/Examples/text-size-util.lisp
@@ -25,7 +25,8 @@
                  :accessor text-size*)
    (%rectangle   :initarg  :rectangle
                  :type     (member nil :text-size :text-bounding-rectangle)
-                 :accessor rectangle)
+                 :accessor rectangle
+                 :initform :text-size)
    (%hook        :initarg  :hook
                  :accessor hook
                  :initform nil))
diff --git a/Extensions/bezier/bezier.lisp b/Extensions/bezier/bezier.lisp
index 2fea27db..80c51553 100644
--- a/Extensions/bezier/bezier.lisp
+++ b/Extensions/bezier/bezier.lisp
@@ -803,7 +803,7 @@ second curve point, yielding (200 50)."
 ;;; Generic drawing.
 
 (defun draw-bezier-design* (sheet design &rest options)
-  (climi::with-medium-options (sheet options)
+  (climi::with-drawing-options* (sheet options)
     (medium-draw-bezier-design* sheet design)))
 
 (defmethod draw-design (medium (design bezier-design)
diff --git a/Extensions/render/image.lisp b/Extensions/render/image.lisp
index 9bb88ace..d0755739 100644
--- a/Extensions/render/image.lisp
+++ b/Extensions/render/image.lisp
@@ -6,7 +6,7 @@
                     &rest args
                     &key clipping-region transformation)
   (declare (ignorable clipping-region transformation args))
-  (climi::with-medium-options (medium args)
+  (climi::with-drawing-options* (medium args)
     (draw-pattern* medium image x y)))
 
 (clim-internals::def-graphic-op draw-image* (image x y))