[mcclim-cvs] CVS mcclim
ahefner
ahefner at common-lisp.net
Mon Feb 5 02:57:18 UTC 2007
Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv5246
Modified Files:
gadgets.lisp
Log Message:
Trivial changes (change :max-height of push-button-pane to +fill+, move
functions around).
--- /project/mcclim/cvsroot/mcclim/gadgets.lisp 2006/12/27 14:47:23 1.103
+++ /project/mcclim/cvsroot/mcclim/gadgets.lisp 2007/02/05 02:57:18 1.104
@@ -203,13 +203,9 @@
;; immediate-sheet-input-mixin
;; immediate-repainting-mixin
basic-pane
- gadget
- )
- ;; Half-baked attempt to be compatible with Lispworks. ??? -moore
- ;; Inherited from basic-pane with different defaults.
- ((foreground :initform +black+)
- #+IGNORE (background :initform +white+) ; This is evil.. -Hefner
- ))
+ gadget)
+ ())
+
;; Where is this standard-gadget from? --GB
@@ -701,8 +697,8 @@
(defclass enter/exit-arms/disarms-mixin ()
()
(:documentation
- "Mixin class for gadgets, which will be armed, when the mouse enters and
- disarmed, when the mouse leaves."))
+ "Mixin class for gadgets which are armed when the mouse enters and
+ disarmed when the mouse leaves."))
(defmethod handle-event :before ((pane enter/exit-arms/disarms-mixin) (event pointer-enter-event))
(declare (ignorable event))
@@ -737,7 +733,12 @@
(declare (ignorable client))
(disarm-gadget gadget))
-;;
+;;;; ------------------------------------------------------------------------------------------
+;;;;
+;;;; Drawing Utilities for Concrete Gadgets
+;;;;
+
+;;; Labels
(defmethod compose-label-space ((gadget labelled-gadget-mixin) &key (wider 0) (higher 0))
(with-slots (label align-x align-y) gadget
@@ -769,11 +770,6 @@
:text-style (pane-text-style pane)
:ink ink))))
-;;;; ------------------------------------------------------------------------------------------
-;;;;
-;;;; Drawing Utilities for Concrete Gadgets
-;;;;
-
;;; 3D-ish Look
;; DRAW-BORDERED-POLYGON medium point-seq &key border-width style
@@ -950,7 +946,10 @@
medium
(polygon-points (make-rectangle* x1 y1 x2 y2))
options))
-
+
+(defun draw-engraved-label* (pane x1 y1 x2 y2)
+ (draw-label* pane (1+ x1) (1+ y1) (1+ x2) (1+ y2) :ink *3d-light-color*)
+ (draw-label* pane x1 y1 x2 y2 :ink *3d-dark-color*))
;;;;
;;;; 3D-BORDER-MIXIN Class
@@ -1040,7 +1039,7 @@
:initarg :show-as-default-p
:accessor push-button-show-as-default-p))
(:default-initargs
- :text-style (make-text-style :sans-serif nil nil)
+ :text-style (make-text-style :sans-serif nil nil)
:background *3d-normal-color*
:align-x :center
:align-y :center
@@ -1076,10 +1075,6 @@
(setf pressedp nil)
(dispatch-repaint pane +everywhere+))))
-(defun draw-engraved-label* (pane x1 y1 x2 y2)
- (draw-label* pane (1+ x1) (1+ y1) (1+ x2) (1+ y2) :ink *3d-light-color*)
- (draw-label* pane x1 y1 x2 y2 :ink *3d-dark-color*))
-
(defmethod handle-repaint ((pane push-button-pane) region)
(declare (ignore region))
(with-slots (armed pressedp) pane
@@ -2044,7 +2039,7 @@
(h (* n (generic-list-pane-item-height pane))))
(make-space-requirement :width w :height h
:min-width w :min-height h
- :max-width +fill+ :max-height h)))
+ :max-width +fill+ :max-height +fill+)))
(defmethod allocate-space ((pane generic-list-pane) w h)
(resize-sheet pane w h))
More information about the Mcclim-cvs
mailing list