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. ;;;