[mcclim-cvs] CVS mcclim

[dlichteblau]

Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv20070

Modified Files:
	gadgets.lisp package.lisp 
Log Message:

Implement (SETF LIST-PANE-ITEMS) as discussed on IRC.

	* package.lisp (CLIM-EXTENSIONS): Export LIST-PANE-ITEMS.

	* Examples/demodemo.lisp: Extend the LIST-TEST to demonstrate the
	new functionality.
	
	* gadgets.lisp ((SETF LIST-PANE-ITEMS)): Add a new generic
	function.  Implement it for GENERIC-LIST-PANE, with some general
	code specialized on META-LIST-PANE.

	* Backends/gtkairo/gadgets.lisp: Implement (SETF LIST-PANE-ITEMS)
	for GTK-LIST, too.

	* Backends/gtkairo/ffi.lisp: regenerated.


--- /project/mcclim/cvsroot/mcclim/gadgets.lisp	2006/11/08 01:18:22	1.101
+++ /project/mcclim/cvsroot/mcclim/gadgets.lisp	2006/12/23 21:44:03	1.102
@@ -2175,6 +2175,48 @@
            (generic-list-pane-handle-click-from-event pane event))
       (when (next-method-p) (call-next-method))))
 
+(defgeneric (setf list-pane-items)
+    (newval pane &key invoke-callback)
+  (:documentation
+   "Set the current list of items for this list pane.
+The current GADGET-VALUE will be adjusted by removing values not
+specified by the new items.  VALUE-CHANGED-CALLBACK will be called
+if INVOKE-CALLBACK is given."))
+
+(defmethod (setf list-pane-items)
+    (newval (pane meta-list-pane) &key invoke-callback)
+  (declare (ignore invoke-callback))
+  (setf (slot-value pane 'items) newval))
+
+(defmethod (setf list-pane-items)
+    :after
+    (newval (pane meta-list-pane) &key invoke-callback)
+  (when (slot-boundp pane 'value)
+    (let ((new-values
+	   (coerce (climi::generic-list-pane-item-values pane) 'list))
+	  (test (list-pane-test pane)))
+      (setf (gadget-value pane :invoke-callback invoke-callback)
+	    (if (list-pane-exclusive-p pane)
+		(if (find (gadget-value pane) new-values :test test)
+		    (gadget-value pane)
+		    nil)
+		(intersection (gadget-value pane) new-values :test test))))))
+
+(defmethod (setf list-pane-items)
+    (newval (pane generic-list-pane) &key invoke-callback)
+  (call-next-method)
+  (with-slots (items items-length item-strings item-values) pane
+    (setf items-length (length newval))
+    (setf item-strings nil)
+    (setf item-values nil)))
+
+(defmethod (setf list-pane-items) :after
+    (newval (pane generic-list-pane) &key invoke-callback)
+  (change-space-requirements
+   pane
+   :height (space-requirement-height (compose-space pane)))
+  (handle-repaint pane +everywhere+))
+
 ;;; OPTION-PANE
 
 (define-abstract-pane-mapping 'option-pane 'generic-option-pane)
--- /project/mcclim/cvsroot/mcclim/package.lisp	2006/12/21 10:36:40	1.57
+++ /project/mcclim/cvsroot/mcclim/package.lisp	2006/12/23 21:44:03	1.58
@@ -1921,7 +1921,8 @@
    #:compose-space-aux
    #:simple-event-loop
    #:pointer-motion-hint-event
-   #:frame-display-pointer-documentation-string))
+   #:frame-display-pointer-documentation-string
+   #:list-pane-items))
 
 ;;; Symbols that must be defined by a backend.
 ;;;