[mcclim-cvs] CVS mcclim - mcclim-cvs@common-lisp.net - mailman3.common-lisp.net

20 Mar 2007

Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv20583
Modified Files:
    bordered-output.lisp medium.lisp 
Log Message:
Merge with medium line style. Eliminated merge-line-styles due to the
contraint in the spec that you can't have NIL components in your line
style.

--- /project/mcclim/cvsroot/mcclim/bordered-output.lisp	2007/03/12 17:36:52	1.16
+++ /project/mcclim/cvsroot/mcclim/bordered-output.lisp	2007/03/20 01:41:17	1.17
@@ -173,13 +173,12 @@
(defmacro %%line-style-for-method ()
   `(or line-style
-    (merge-line-styles
-     (make-line-style
-      :unit      (or line-unit :point)
-      :thickness (or line-thickness 1)
-      :cap-shape (or line-cap-shape :butt)
-      :dashes    line-dashes)
-     (medium-line-style stream))))
+    (let ((mls (medium-line-style stream)))
+      (make-line-style
+       :unit      (or line-unit (line-style-unit mls))
+       :thickness (or line-thickness (line-style-thickness mls))
+       :cap-shape (or line-cap-shape (line-style-cap-shape mls))
+       :dashes    (or line-dashes (line-style-dashes mls))))))
(defmacro %%adjusting-for-padding (&body body)
   `(let ((left   (- left   padding-left))
@@ -201,7 +200,7 @@
   ;; The Franz User guide implies that &key isn't needed.
   (pushnew '&key arglist)
   `(progn
-    (pushnew ,shape *border-types*)
+    (pushnew ',shape *border-types*)
     (defmethod draw-output-border-over ((shape (eql ',shape)) stream record
                                         &rest drawing-options)
       (with-border-edges (stream record)
@@ -675,7 +674,7 @@
                                                     new-drawing-options)
                    ;; Great, this again..
                    (queue-repaint stream
-                     (make-instance 'window-repaint-event
+                      (make-instance 'window-repaint-event
                                     :sheet stream
                                     :region (transform-region
                                              (sheet-native-transformation stream)
--- /project/mcclim/cvsroot/mcclim/medium.lisp	2007/02/05 02:57:58	1.62
+++ /project/mcclim/cvsroot/mcclim/medium.lisp	2007/03/20 01:41:17	1.63
@@ -500,18 +500,6 @@
        (eql (line-style-cap-shape style1) (line-style-cap-shape style2))
        (eql (line-style-dashes style1) (line-style-dashes style2))))
-(defun merge-line-styles (a b)
-  (make-line-style :unit (or (line-style-unit a)
-                             (line-style-unit b))
-                   :thickness (or (line-style-thickness a)
-                                  (line-style-thickness b))
-                   :joint-shape (or (line-style-joint-shape a)
-                                    (line-style-joint-shape b))
-                   :cap-shape (or (line-style-cap-shape a)
-                                  (line-style-cap-shape b))
-                   :dashes (or (line-style-dashes a)
-                               (line-style-dashes b))))
-
 
 ;;; Misc ops

    