Sundry fixes to run without multiprocessing support.

Added images/ to hold bitmaps for tests.

Added looks/ to hold neutral look-and-feel realizer packages.

Added Examples/gadget-test to test many gadgets with a look and feel.

Added a pixie look and feel, and a pixie/clx to work with the clx backend.

Added drawing support in the CLX backend for ovals and circles.

Fixed pixmaps to work with with-output-to-pixmap with draw-image, etc.

Moved sheet-leaf-mixin to standard-gadget-pane so it doesn't break radio-box-pane, etc.

Misc fixes.

Backends/CLX/image.lisp

@@ -243,7 +243,7 @@
                          &key clipping-region transformation)
   (declare (ignorable args))
   (with-sheet-medium (medium sheet)
-    (setf (medium-transformation medium) (or transformation +identity-transformation+)
+    (setf (medium-transformation medium)  (or transformation +identity-transformation+)
 	  (medium-clipping-region medium) (or clipping-region +everywhere+))
     (medium-draw-image* medium image)))
 

Backends/CLX/medium.lisp

@@ -36,7 +36,7 @@
 
 (defclass clx-medium (basic-medium)
   ((gc :initform nil)
-   ) )
+   ))
 
 
 ;;; secondary methods for changing text styles and line styles
@@ -102,7 +102,7 @@
       (setf (xlib:gcontext-font gc) (text-style-to-X-font port (medium-text-style medium))
 	    (xlib:gcontext-foreground gc) (X-pixel port ink)
 	    (xlib:gcontext-background gc) (X-pixel port (medium-background medium)))
-      ;; Here is a bug with regard to clipping ... ;-( --GB
+      ;; Here is a bug with regard to clipping ... ;-( --GB )
       #+NIL
       (let ((clipping-region (medium-device-region medium)))
         (unless (region-equal clipping-region +nowhere+)
@@ -326,6 +326,27 @@
                        start-angle (- end-angle start-angle)
                        filled)))))
 
+(defmethod medium-draw-oval* ((medium clx-medium) center-x center-y radius-x radius-y filled)
+  (with-transformed-position ((sheet-native-transformation (medium-sheet medium))
+                              center-x center-y)
+    (with-CLX-graphics (medium)
+      (xlib:draw-arc mirror gc
+                     (round (- center-x radius-x)) (round (- center-y radius-y))
+                     (round (* radius-x 2)) (round (* radius-y 2))
+                     0.0 (* 2 pi)
+                     filled))))
+
+(defmethod medium-draw-circle* ((medium clx-medium) center-x center-y radius start-angle end-angle filled)
+  (with-transformed-position ((sheet-native-transformation (medium-sheet medium))
+                              center-x center-y)
+    (with-CLX-graphics (medium)
+      (xlib:draw-arc mirror gc
+                     (round (- center-x radius-dx)) (round (- center-y radius-dy))
+                     radius radius
+                     start-angle (- end-angle start-angle)
+                     filled))))
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; Methods for text styles
@@ -494,4 +515,3 @@
     (funcall continuation sheet)))
 
 ;;;;
-

Backends/CLX/port.lisp

@@ -65,7 +65,10 @@
 (defmethod initialize-clx ((port clx-port))
   (let ((options (cdr (port-server-path port))))
     (setf (clx-port-display port)
-      (xlib:open-display (getf options :host "") :display (getf options :display-id 0)))
+      #-sbcl
+      (xlib:open-display (getf options :host "") :display (getf options :display-id 0))
+      #+sbcl
+      (xlib:open-display "localhost" :display (getf options :display-id 0)))
 
     (progn
       #+NIL
@@ -133,11 +136,19 @@
 					      :button-press :button-release
 					      :enter-window :leave-window
 					      :structure-notify
-					      :pointer-motion)))
+					     ;:pointer-motion
+                                              :button-motion)))
   (when (null (port-lookup-mirror port sheet))
-    (let* ((desired-color (if (typep sheet 'sheet-with-medium-mixin)
-                              (medium-background sheet)
-                            +white+))
+    (let* ((desired-color (typecase sheet
+                            (sheet-with-medium-mixin
+                              (medium-background sheet))
+                            (basic-pane ; CHECKME [is this sensible?] seems to be
+                              (let ((background (pane-background sheet)))
+                                (if (typep background 'color)
+                                    background
+                                    +white+)))
+                            (t
+                              +white+)))
            (color (multiple-value-bind (r g b)
                       (color-rgb desired-color)
                     (xlib:make-color :red r :green g :blue b)))
@@ -184,16 +195,29 @@
   (realize-mirror-aux port sheet
 		      :override-redirect :on
 		      :map nil
-		      :event-mask '(:structure-notify)))
+		      :event-mask '(:structure-notify
+                                    )))
 
 (defmethod realize-mirror ((port clx-port) (sheet menu-button-pane))
+  (realize-mirror-aux port sheet
+		      :event-mask '(:exposure
+				    :key-press :key-release
+				    :button-press :button-release
+				    :enter-window :leave-window
+				    :structure-notify
+				   ;:pointer-motion
+				    :button-motion
+				    :owner-grab-button)))
+
+(defmethod realize-mirror ((port clx-port) (sheet interactor-pane))
   (realize-mirror-aux port sheet
 		      :event-mask '(:exposure
 				    :key-press :key-release
 				    :button-press :button-release
 				    :enter-window :leave-window
 				    :structure-notify
 				    :pointer-motion
+				    :button-motion
 				    :owner-grab-button)))
 
 (defmethod destroy-mirror ((port clx-port) (sheet mirrored-sheet-mixin))
@@ -260,8 +284,13 @@
 (defmethod destroy-port :before ((port clx-port))
   (xlib:close-display (clx-port-display port)))
 
+(defun peek-event (display)
+  (xlib:process-event display :timeout 0 :peek-p t :handler
+    #'(lambda (&key event-key &allow-other-keys)
+        event-key)))
+
 (defun event-handler (&rest event-slots
-                      &key display window event-key code state mode time width height x y data
+                      &key display window event-key code state mode time width height x y data count
                       &allow-other-keys)
   (let ((sheet (and window
 		    (port-lookup-sheet *clx-port* window))))
@@ -297,13 +326,17 @@
 	(:destroy-notify
 	 (make-instance 'window-destroy-event :sheet sheet))
 	(:motion-notify
-	 (make-instance 'pointer-motion-event :pointer 0 :button code :x x :y y
-			:sheet sheet :modifier-state state :timestamp time))
-	((:exposure :display)
-         (make-instance 'window-repaint-event
-           :sheet sheet
-           :region (untransform-region (sheet-native-transformation sheet)
-                                       (make-rectangle* x y (+ x width) (+ y height)))))
+         (unless (eq :motion-notify (peek-event display))
+           ; consolidate motion notifications
+	   (make-instance 'pointer-motion-event :pointer 0 :button code :x x :y y
+			  :sheet sheet :modifier-state state :timestamp time)))
+	((:exposure :display) ; what is a :display event?
+         (when (eq count 0)
+           ; this should also consolidate the areas, but try this for now
+           (make-instance 'window-repaint-event
+             :sheet sheet
+             :region (untransform-region (sheet-native-transformation sheet)
+                                         (make-rectangle* x y (+ x width) (+ y height))))))
 	(:client-message
 	 (when (eq (xlib:atom-name display (aref data 0)) :wm_delete_window)
 	   (destroy-mirror (port sheet) sheet)
@@ -315,10 +348,11 @@
 
 (defmethod get-next-event ((port clx-port) &key wait-function (timeout nil))
   (declare (ignore wait-function))
-  (let ((*clx-port* port))
+  (let* ((*clx-port* port)
+         (display    (clx-port-display port)))
     (declare (special *clx-port*))
-    (xlib:display-finish-output (clx-port-display port))
-;    (xlib:process-event (clx-port-display port) :timeout timeout :handler #'event-handler :discard-p t)))
+    (unless (xlib:event-listen display)
+      (xlib:display-finish-output (clx-port-display port)))
     ; temporary solution
     (or (xlib:process-event (clx-port-display port) :timeout timeout :handler #'event-handler :discard-p t)
 	:timeout)))

Examples/clim-fig.lisp

@@ -199,7 +199,16 @@
   (loop for port in climi::*all-ports*
       do (destroy-port port))
   (setq climi::*all-ports* nil)
-  (run-frame-top-level (make-application-frame 'clim-fig)))
+ ;(run-frame-top-level (make-application-frame 'clim-fig))
+  (setq frame (make-application-frame 'clim-fig))
+  (setq fm (frame-manager frame))
+  (setq port (climi::frame-manager-port fm))
+  (setq pane (first (frame-panes frame)))
+  (setq medium (sheet-medium pane))
+  (setq graft (graft frame))
+  (setq vbox (climi::frame-pane frame))
+  (unless clim-sys:*multiprocessing-p*
+    (run-frame-top-level frame)))
 
 (defun make-colored-button (color &key width height)
   (make-pane 'push-button-pane
@@ -345,25 +354,25 @@
                          (setf (clim-fig-constrict-mode *application-frame*) value)))
 
    ;; Drawing modes
-   (point-button (make-drawing-mode-button "Point" :point))
-   (line-button (make-drawing-mode-button "Line" :line))
-   (arrow-button (make-drawing-mode-button "Arrow" :arrow))
+   (point-button     (make-drawing-mode-button "Point" :point))
+   (line-button      (make-drawing-mode-button "Line" :line))
+   (arrow-button     (make-drawing-mode-button "Arrow" :arrow))
    (rectangle-button (make-drawing-mode-button "Rectangle" :rectangle))
-   (ellipse-button (make-drawing-mode-button "Ellipse" :ellipse))
+   (ellipse-button   (make-drawing-mode-button "Ellipse" :ellipse))
 
    ;; Colors
-   (black-button (make-colored-button +black+))
-   (blue-button (make-colored-button +blue+))
-   (green-button (make-colored-button +green+))
-   (cyan-button (make-colored-button +cyan+))
-   (red-button (make-colored-button +red+))
-   (magenta-button (make-colored-button +magenta+))
-   (yellow-button (make-colored-button +yellow+))
-   (white-button (make-colored-button +white+))
+   (black-button     (make-colored-button +black+))
+   (blue-button      (make-colored-button +blue+))
+   (green-button     (make-colored-button +green+))
+   (cyan-button      (make-colored-button +cyan+))
+   (red-button       (make-colored-button +red+))
+   (magenta-button   (make-colored-button +magenta+))
+   (yellow-button    (make-colored-button +yellow+))
+   (white-button     (make-colored-button +white+))
    (turquoise-button (make-colored-button +turquoise+))
-   (grey-button (make-colored-button +grey+))
-   (brown-button (make-colored-button +brown+))
-   (orange-button (make-colored-button +orange+))
+   (grey-button      (make-colored-button +grey+))
+   (brown-button     (make-colored-button +brown+))
+   (orange-button    (make-colored-button +orange+))
 
    (undo :push-button
          :label "Undo"
@@ -413,17 +422,3 @@
     (catch 'exit
       (clim-extensions:simple-event-loop))
     (frame-exit frame)))
-
-; (defmethod clim-fig-frame-top-level ((frame application-frame) &key)
-;   (let ((*standard-input* (frame-standard-input frame))
-; 	(*standard-output* (frame-standard-output frame))
-; 	(*query-io* (frame-query-io frame)))
-;     (setf (slot-value frame 'output-record)
-;           (stream-current-output-record *standard-output*)
-;           (slot-value frame 'status)
-;           (find-if #'(lambda (pane) (typep pane 'text-field-pane))
-;                    (frame-panes frame)))
-;     (catch 'exit
-;       (loop (read-command (climi::frame-pane frame))))
-;     (destroy-port (port frame))))
-