[mcclim-devel] Patch: Color name symbol case.
Douglas Crosher
dtc at scieneer.com
Tue Oct 17 21:04:23 EDT 2006
* Adjust some of the color names to support lower case CL variants.
Note that the names used for colors could use some review. Many colors
are named using C style conventions such as +RoyalBlue3+, but this is exported
as +royalblue3+ which is no different under standard CL but this does make a
difference on a case sensitive CL variant. Perhaps renaming these all to use
CL conventions such as +royal-blue3+ would be appropriate? The attached patch
makes minimal additions to the color names to get the code and examples working.
Regards
Douglas Crosher
-------------- next part --------------
Index: X11-colors.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/X11-colors.lisp,v
retrieving revision 1.2
diff -u -u -r1.2 X11-colors.lisp
--- X11-colors.lisp 21 Mar 2003 21:36:58 -0000 1.2
+++ X11-colors.lisp 18 Oct 2006 00:13:47 -0000
@@ -303,6 +303,7 @@
(defconstant +RoyalBlue1+ (make-named-color "RoyalBlue1" 0.2824 0.4627 1.0000))
(defconstant +RoyalBlue2+ (make-named-color "RoyalBlue2" 0.2627 0.4314 0.9333))
(defconstant +RoyalBlue3+ (make-named-color "RoyalBlue3" 0.2275 0.3725 0.8039))
+(defconstant +royal-blue4+ (make-named-color "royal-blue4" 0.1529 0.2510 0.5451))
(defconstant +RoyalBlue4+ (make-named-color "RoyalBlue4" 0.1529 0.2510 0.5451))
(defconstant +blue1+ (make-named-color "blue1" 0.0000 0.0000 1.0000))
(defconstant +blue2+ (make-named-color "blue2" 0.0000 0.0000 0.9333))
@@ -347,6 +348,7 @@
(defconstant +PaleTurquoise1+ (make-named-color "PaleTurquoise1" 0.7333 1.0000 1.0000))
(defconstant +PaleTurquoise2+ (make-named-color "PaleTurquoise2" 0.6824 0.9333 0.9333))
(defconstant +PaleTurquoise3+ (make-named-color "PaleTurquoise3" 0.5882 0.8039 0.8039))
+(defconstant +pale-turquoise4+ (make-named-color "pale-turquoise4" 0.4000 0.5451 0.5451))
(defconstant +PaleTurquoise4+ (make-named-color "PaleTurquoise4" 0.4000 0.5451 0.5451))
(defconstant +CadetBlue1+ (make-named-color "CadetBlue1" 0.5961 0.9608 1.0000))
(defconstant +CadetBlue2+ (make-named-color "CadetBlue2" 0.5569 0.8980 0.9333))
@@ -395,6 +397,7 @@
(defconstant +OliveDrab1+ (make-named-color "OliveDrab1" 0.7529 1.0000 0.2431))
(defconstant +OliveDrab2+ (make-named-color "OliveDrab2" 0.7020 0.9333 0.2275))
(defconstant +OliveDrab3+ (make-named-color "OliveDrab3" 0.6039 0.8039 0.1961))
+(defconstant +olive-drab4+ (make-named-color "olive-drab4" 0.4118 0.5451 0.1333))
(defconstant +OliveDrab4+ (make-named-color "OliveDrab4" 0.4118 0.5451 0.1333))
(defconstant +DarkOliveGreen1+ (make-named-color "DarkOliveGreen1" 0.7922 1.0000 0.4392))
(defconstant +DarkOliveGreen2+ (make-named-color "DarkOliveGreen2" 0.7373 0.9333 0.4078))
Index: gadgets.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/gadgets.lisp,v
retrieving revision 1.100
diff -u -u -r1.100 gadgets.lisp
--- gadgets.lisp 17 Apr 2006 18:37:21 -0000 1.100
+++ gadgets.lisp 18 Oct 2006 00:13:51 -0000
@@ -1021,8 +1021,8 @@
(defmethod effective-gadget-input-area-color ((gadget basic-gadget))
(if (gadget-active-p gadget)
- +lemonchiffon+
- (compose-over (compose-in +lemonchiffon+ (make-opacity .5))
+ +lemon-chiffon+
+ (compose-over (compose-in +lemon-chiffon+ (make-opacity .5))
(pane-background gadget))))
;;; ------------------------------------------------------------------------------------------
@@ -1927,7 +1927,7 @@
standard-sheet-input-mixin ;; Hmm..
value-changed-repaint-mixin
mouse-wheel-scroll-mixin)
- ((highlight-ink :initform +royalblue4+
+ ((highlight-ink :initform +royal-blue4+
:initarg :highlight-ink
:reader list-pane-highlight-ink)
(item-strings :initform nil
Index: package.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/package.lisp,v
retrieving revision 1.55
diff -u -u -r1.55 package.lisp
--- package.lisp 29 Jun 2006 08:16:02 -0000 1.55
+++ package.lisp 18 Oct 2006 00:13:55 -0000
@@ -1716,7 +1716,8 @@
#:+mistyrose1+ #:+mistyrose2+ #:+mistyrose3+ #:+mistyrose4+
#:+azure1+ #:+azure2+ #:+azure3+ #:+azure4+
#:+slateblue1+ #:+slateblue2+ #:+slateblue3+ #:+slateblue4+
- #:+royalblue1+ #:+royalblue2+ #:+royalblue3+ #:+royalblue4+
+ #:+royalblue1+ #:+royalblue2+ #:+royalblue3+
+ #:+royal-blue4+ #:+royalblue4+
#:+blue1+ #:+blue2+ #:+blue3+ #:+blue4+
#:+dodgerblue1+ #:+dodgerblue2+ #:+dodgerblue3+ #:+dodgerblue4+
#:+steelblue1+ #:+steelblue2+ #:+steelblue3+ #:+steelblue4+
@@ -1727,7 +1728,8 @@
#:+lightsteelblue1+ #:+lightsteelblue2+ #:+lightsteelblue3+ #:+lightsteelblue4+
#:+lightblue1+ #:+lightblue2+ #:+lightblue3+ #:+lightblue4+
#:+lightcyan1+ #:+lightcyan2+ #:+lightcyan3+ #:+lightcyan4+
- #:+paleturquoise1+ #:+paleturquoise2+ #:+paleturquoise3+ #:+paleturquoise4+
+ #:+paleturquoise1+ #:+paleturquoise2+ #:+paleturquoise3+
+ #:+pale-turquoise4+ #:+paleturquoise4+
#:+cadetblue1+ #:+cadetblue2+ #:+cadetblue3+ #:+cadetblue4+
#:+turquoise1+ #:+turquoise2+ #:+turquoise3+ #:+turquoise4+
#:+cyan1+ #:+cyan2+ #:+cyan3+ #:+cyan4+
@@ -1739,7 +1741,8 @@
#:+springgreen1+ #:+springgreen2+ #:+springgreen3+ #:+springgreen4+
#:+green1+ #:+green2+ #:+green3+ #:+green4+
#:+chartreuse1+ #:+chartreuse2+ #:+chartreuse3+ #:+chartreuse4+
- #:+olivedrab1+ #:+olivedrab2+ #:+olivedrab3+ #:+olivedrab4+
+ #:+olivedrab1+ #:+olivedrab2+ #:+olivedrab3+ #:+olive-drab4+
+ #:+olivedrab4+
#:+darkolivegreen1+ #:+darkolivegreen2+ #:+darkolivegreen3+ #:+darkolivegreen4+
#:+khaki1+ #:+khaki2+ #:+khaki3+ #:+khaki4+
#:+lightgoldenrod1+ #:+lightgoldenrod2+ #:+lightgoldenrod3+ #:+lightgoldenrod4+
Index: Apps/Listener/dev-commands.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Apps/Listener/dev-commands.lisp,v
retrieving revision 1.35
diff -u -u -r1.35 dev-commands.lisp
--- Apps/Listener/dev-commands.lisp 10 Apr 2006 21:24:53 -0000 1.35
+++ Apps/Listener/dev-commands.lisp 18 Oct 2006 00:14:06 -0000
@@ -313,7 +313,7 @@
(princ (symbol-name symbol) stream)))
(when (boundp symbol)
(format stream " = ")
- (with-drawing-options (stream :ink +olivedrab+ ;; XXX
+ (with-drawing-options (stream :ink +olive-drab+ ;; XXX
:text-style (make-text-style :fix :roman :small))
(let ((object (symbol-value symbol)))
(present object (presentation-type-of object) :stream stream)))))))
@@ -1444,7 +1444,7 @@
(t (present object))))
(defun display-evalues (values)
- (with-drawing-options (t :ink +olivedrab+)
+ (with-drawing-options (t :ink +olive-drab+)
(cond ((null values)
(format t "No values.~%"))
((= 1 (length values))
@@ -1453,7 +1453,7 @@
(t (do ((i 0 (1+ i))
(item values (rest item)))
((null item))
- (with-drawing-options (t :ink +limegreen+)
+ (with-drawing-options (t :ink +lime-green+)
(with-text-style (t (make-text-style nil :italic :small))
(format t "~A " i)))
(hackish-present (first item))
Index: Apps/Listener/listener.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Apps/Listener/listener.lisp,v
retrieving revision 1.26
diff -u -u -r1.26 listener.lisp
--- Apps/Listener/listener.lisp 10 May 2006 11:19:33 -0000 1.26
+++ Apps/Listener/listener.lisp 18 Oct 2006 00:14:07 -0000
@@ -40,7 +40,7 @@
(defun print-package-name (stream)
(let ((foo (package-name *package*)))
- (with-drawing-options (stream :ink +royalblue+)
+ (with-drawing-options (stream :ink +royal-blue+)
(format stream "~A" (reduce (lambda (&optional (a foo) (b foo))
(if (< (length a) (length b)) a b))
(package-nicknames *package*))))))
Index: Examples/demodemo.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Examples/demodemo.lisp,v
retrieving revision 1.13
diff -u -u -r1.13 demodemo.lisp
--- Examples/demodemo.lisp 3 Jul 2006 04:58:41 -0000 1.13
+++ Examples/demodemo.lisp 18 Oct 2006 00:14:14 -0000
@@ -115,8 +115,8 @@
(labelling (:label "Some Label"
:align-x ax
:label-alignment ay
- :foreground +WHITE+
- :background +PALETURQUOISE4+
+ :foreground +white+
+ :background +pale-turquoise4+
:text-style (make-text-style :sans-serif :roman :normal))
(make-pane 'push-button-pane :label (format nil "~S" (list ax ay))
:text-style (make-text-style :sans-serif :roman :normal)
@@ -127,8 +127,8 @@
(labelling (:label (format nil "~(~S~)" (list ax ay))
:align-x ax
:label-alignment ay
- :foreground +WHITE+
- :background +PALETURQUOISE4+
+ :foreground +white+
+ :background +pale-turquoise4+
:text-style (make-text-style :sans-serif :roman :normal))
#+nil
(make-pane 'push-button-pane :label
Index: Examples/gadget-test.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Examples/gadget-test.lisp,v
retrieving revision 1.13
diff -u -u -r1.13 gadget-test.lisp
--- Examples/gadget-test.lisp 23 Apr 2006 15:42:42 -0000 1.13
+++ Examples/gadget-test.lisp 18 Oct 2006 00:14:14 -0000
@@ -112,7 +112,7 @@
("View" :menu view-menu)
("Search" :menu search-menu)))
(:panes
-; (raised (raising (:border-width 3 :background +Gray83+)
+; (raised (raising (:border-width 3 :background +gray83+)
; (make-pane 'check-box :choices '("First" "Second" "Third"))))
(tf1 :push-button
:text-style (make-text-style :fix :roman 24)
@@ -160,7 +160,7 @@
:current-color +black+
:value 0)
(radar (make-pane 'radar-pane :name 'radar))
- (push-btn (lowering (:border-width 3 :background +Gray83+)
+ (push-btn (lowering (:border-width 3 :background +gray83+)
(horizontally ()
(push-button
:name "Radiate"
@@ -172,7 +172,7 @@
:label "No, Push Me")
(push-button
:label "Me!"))))
- (table (lowering (:border-width 3 :background +Gray83+)
+ (table (lowering (:border-width 3 :background +gray83+)
(tabling (:height 50)
(list (push-button :label "A") (push-button :label "B"))
(list (push-button :label "C") (push-button :label "D"))
@@ -183,8 +183,8 @@
:normal +red+
:highlighted +red+
:pushed-and-highlighted +red+)
- (scroll (raising (:border-width 1 :background +Gray83+)
- (scrolling (:background +Gray83+ :width 100 :height 100)
+ (scroll (raising (:border-width 1 :background +gray83+)
+ (scrolling (:background +gray83+ :width 100 :height 100)
(horizontally ()
(vertically ()
(push-button :label "This is a button")
@@ -207,7 +207,7 @@
(clim:radio-box-current-selection "First") "Second" "Third")))
(:layouts
(default
- (raising (:border-width 5 :background +Gray83+)
+ (raising (:border-width 5 :background +gray83+)
(horizontally ()
(vertically ()
(horizontally ()
Index: Examples/method-browser.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Examples/method-browser.lisp,v
retrieving revision 1.3
diff -u -u -r1.3 method-browser.lisp
--- Examples/method-browser.lisp 29 Mar 2006 09:36:30 -0000 1.3
+++ Examples/method-browser.lisp 18 Oct 2006 00:14:14 -0000
@@ -335,7 +337,7 @@
(if (not (typep *application-frame* 'method-browser))
+foreground-ink+
(if (member spec (arg-types *application-frame*))
- +OliveDrab4+
+ +olive-drab4+
+grey18+)))
(defparameter *column-header-ink* +gray50+)
Index: Looks/pixie.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Looks/pixie.lisp,v
retrieving revision 1.16
diff -u -u -r1.16 pixie.lisp
--- Looks/pixie.lisp 29 Mar 2006 10:43:50 -0000 1.16
+++ Looks/pixie.lisp 18 Oct 2006 00:14:18 -0000
@@ -662,7 +666,7 @@
(with-special-choices (pane)
(let* ((region (sheet-region pane))
(frame (polygon-points (bounding-rectangle region))))
- (draw-polygon pane frame :ink +Blue+ :filled t)
+ (draw-polygon pane frame :ink +blue+ :filled t)
(draw-bordered-polygon pane frame :style :outset :border-width 1))))
(defmethod compose-space ((gadget pixie-menu-bar-pane) &key width height)
More information about the mcclim-devel
mailing list