[mcclim-cvs] CVS mcclim
ahefner
ahefner at common-lisp.net
Tue Mar 20 01:41:17 UTC 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
More information about the Mcclim-cvs
mailing list