internals: remove protocol that duplicates functionality

We had INVOKE-WITH-DRAWING-OPTIONS and DO-GRAPHICS-WITH-OPTIONS that served the
same purpose with the former trampolining to the latter. Removing the duplicated
interfaces brings more consistency and lowers the cognitive bar.

8 files changed, 75 insertions, 94 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/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/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..0d67da44 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)))
 
 
diff --git a/Core/windowing/output.lisp b/Core/windowing/output.lisp
index 3da9d2b8..ad3ac889 100644
--- a/Core/windowing/output.lisp
+++ b/Core/windowing/output.lisp
@@ -141,16 +141,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 +167,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 +254,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 +264,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 +274,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 +283,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 +300,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 +313,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 +321,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 +339,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 +415,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/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))