[graphic-forms-cvs] r250 - in trunk: docs/manual src src/tests/uitoolkit src/uitoolkit/system src/uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Thu Sep 7 05:46:42 UTC 2006
Author: junrue
Date: Thu Sep 7 01:46:41 2006
New Revision: 250
Modified:
trunk/docs/manual/reference.texinfo
trunk/docs/manual/widget-functions.texinfo
trunk/docs/manual/widget-types.texinfo
trunk/src/packages.lisp
trunk/src/tests/uitoolkit/widget-tester.lisp
trunk/src/uitoolkit/system/system-utils.lisp
trunk/src/uitoolkit/widgets/item-manager.lisp
trunk/src/uitoolkit/widgets/item.lisp
trunk/src/uitoolkit/widgets/list-box.lisp
trunk/src/uitoolkit/widgets/list-item.lisp
trunk/src/uitoolkit/widgets/menu.lisp
trunk/src/uitoolkit/widgets/widget-classes.lisp
trunk/src/uitoolkit/widgets/widget.lisp
Log:
revised item-manager protocol so that now we have selected-items and selected-span, implemented selected-items for list-box and fixed up menu implementation, more debugging/bugfixing via widget-tester
Modified: trunk/docs/manual/reference.texinfo
==============================================================================
--- trunk/docs/manual/reference.texinfo (original)
+++ trunk/docs/manual/reference.texinfo Thu Sep 7 01:46:41 2006
@@ -69,6 +69,10 @@
@acronym{GFW}
@end macro
+ at macro apps-shouldnt-call-function
+This function should typically not be called from application code.
+ at end macro
+
@macro event-dispatcher-arg
@item event-dispatcher
The @ref{event-dispatcher} to process this event.
Modified: trunk/docs/manual/widget-functions.texinfo
==============================================================================
--- trunk/docs/manual/widget-functions.texinfo (original)
+++ trunk/docs/manual/widget-functions.texinfo Thu Sep 7 01:46:41 2006
@@ -568,6 +568,8 @@
data structures) with data derived from the @var{items} slot.
If @var{self} has been assigned a sorting predicate, the array
of items will be sorted prior to the internal model update.
+
+ at apps-shouldnt-call-function
@end deffn
@anchor{update-native-style}
@@ -576,6 +578,8 @@
@var{integer} and calls any additional API needed to ensure that
@var{self}'s visual representation is refreshed. The supplied
@var{integer} is returned.
+
+ at apps-shouldnt-call-function
@end deffn
@anchor{vertical-scrollbar-p}
Modified: trunk/docs/manual/widget-types.texinfo
==============================================================================
--- trunk/docs/manual/widget-types.texinfo (original)
+++ trunk/docs/manual/widget-types.texinfo Thu Sep 7 01:46:41 2006
@@ -375,7 +375,8 @@
@begin-control-subclass{list-box,
This @ref{control} subclass represents a list of selectable items; it
also inherits @ref{item-manager}. The list is always visible\, unlike
-a combo-box.,
+a combo-box. Each of the @code{-select} style keywords mentioned below
+are exclusive.,
event-select}
@control-callback-initarg{list-box,event-select}
@deffn Initarg :estimated-count
@@ -400,11 +401,13 @@
keys.
@item :multiple-select
This style keyword enables individual toggling of multiple item
-selections within the list-box. Without this style, the list-box will
-only allow a single selection.
+selections within the list-box.
@item :no-select
This style keyword means that the list-box will display items but
not allow any selections.
+ at item :single-select
+This style keyword means that the list-box only allows one item at a
+time to be selected. This is the default selection style.
@item :tab-stops
This style keyword configures the list-box to to expand tab characters
when rendering item strings.
Modified: trunk/src/packages.lisp
==============================================================================
--- trunk/src/packages.lisp (original)
+++ trunk/src/packages.lisp Thu Sep 7 01:46:41 2006
@@ -520,7 +520,6 @@
#:trim-sizes
#:undo-available-p
#:update
- #:update-from-items
#:vertical-scrollbar
#:visible-item-count
#:visible-p
Modified: trunk/src/tests/uitoolkit/widget-tester.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/widget-tester.lisp (original)
+++ trunk/src/tests/uitoolkit/widget-tester.lisp Thu Sep 7 01:46:41 2006
@@ -65,15 +65,50 @@
(gfg:foreground-color gc) color))
(gfg:draw-filled-rectangle gc (gfs:make-rectangle :size (gfw:client-size window))))
-(defun lb-select (disp lb)
- (declare (ignore disp))
- (print lb))
+(defun manage-lb-button-states (lb move-btn all-btn none-btn)
+ (let ((count (gfw:selected-count lb))
+ (items (gfw:items-of lb)))
+ (gfw:enable move-btn (> count 0))
+ (if all-btn
+ (gfw:enable all-btn (< count (length items))))
+ (if none-btn
+ (gfw:enable none-btn (> count 0)))))
+
+(defun move-lb-content (orig-lb dest-lb)
+ (let ((sel-items (gfw:selected-items orig-lb)))
+ (if sel-items
+ (setf (gfw:items-of dest-lb) (append sel-items (gfw:items-of dest-lb))))))
(defun populate-list-box-test-panel ()
(setf (gfw:text *widget-tester-win*) "Widget Tester (List Boxes)")
(let* ((panel-disp (make-instance 'widget-tester-panel-events))
- (lb1 nil)
- (lb2 nil)
+ (lb1 nil)
+ (lb2 nil)
+ (btn-left nil)
+ (btn-right nil)
+ (btn-all nil)
+ (btn-none nil)
+ (lb1-callback (lambda (disp lb)
+ (declare (ignore disp))
+ (manage-lb-button-states lb btn-right btn-all btn-none)))
+ (lb2-callback (lambda (disp lb)
+ (declare (ignore disp))
+ (manage-lb-button-states lb btn-left nil nil)))
+ (btn-left-callback (lambda (disp btn)
+ (declare (ignore disp btn))
+ (move-lb-content lb2 lb1)
+ (manage-lb-button-states lb1 btn-right btn-all btn-none)
+ (manage-lb-button-states lb2 btn-left btn-all btn-none)))
+ (btn-right-callback (lambda (disp btn)
+ (declare (ignore disp btn))
+ (move-lb-content lb1 lb2)
+ (manage-lb-button-states lb1 btn-right btn-all btn-none)
+ (manage-lb-button-states lb2 btn-left btn-all btn-none)))
+ (btn-all-callback (lambda (disp btn)
+ (declare (ignore disp btn))))
+ (btn-none-callback (lambda (disp btn)
+ (declare (ignore disp btn))))
+
(outer-panel (make-instance 'gfw:panel :dispatcher panel-disp
:parent *widget-tester-win*
:layout (make-instance 'gfw:flow-layout :spacing 4 :margins 4)))
@@ -82,26 +117,43 @@
:layout (make-instance 'gfw:flow-layout :style '(:vertical) :spacing 4 :margins 4)))
(btn-panel (make-instance 'gfw:panel :dispatcher panel-disp
:parent outer-panel
- :layout (make-instance 'gfw:flow-layout :style '(:vertical) :spacing 4 :margins 4)))
+ :layout (make-instance 'gfw:flow-layout :style '(:vertical :normalize) :spacing 4 :margins 4)))
(lb2-panel (make-instance 'gfw:panel :dispatcher panel-disp
:parent outer-panel
:layout (make-instance 'gfw:flow-layout :style '(:vertical) :spacing 4 :margins 4))))
+
(make-instance 'gfw:label :text "Multiple Select:" :parent lb1-panel)
(setf lb1 (make-instance 'gfw:list-box :parent lb1-panel
- :callback #'lb-select
+ :callback lb1-callback
:sort-predicate #'string<
:style '(:multiple-select)
:items (subseq *list-box-test-data* 4)))
(gfw:pack lb1-panel)
- (gfw:enable (make-instance 'gfw:button :parent btn-panel :text " ==> ") nil)
- (gfw:enable (make-instance 'gfw:button :parent btn-panel :text " <== ") nil)
+
+ (setf btn-right (make-instance 'gfw:button :parent btn-panel
+ :text " ==> "
+ :callback btn-right-callback))
+ (gfw:enable btn-right nil)
+ (setf btn-left (make-instance 'gfw:button :parent btn-panel
+ :text " <== "
+ :callback btn-left-callback))
+ (gfw:enable btn-left nil)
+ (setf btn-all (make-instance 'gfw:button :parent btn-panel
+ :text "Select All"
+ :callback btn-all-callback))
+ (setf btn-none (make-instance 'gfw:button :parent btn-panel
+ :text "Select None"
+ :callback btn-none-callback))
+ (gfw:enable btn-none nil)
(gfw:pack btn-panel)
+
(make-instance 'gfw:label :text "Extended Select:" :parent lb2-panel)
(setf lb2 (make-instance 'gfw:list-box :parent lb2-panel
- :callback #'lb-select
+ :callback lb2-callback
:style '(:extend-select :want-scrollbar)
:items (subseq *list-box-test-data* 4)))
(gfw:pack lb2-panel)
+
(gfw:pack outer-panel)
(let ((size (gfw:size lb1)))
(setf (gfw:maximum-size lb1) size
@@ -109,7 +161,6 @@
(gfw:maximum-size lb2) size
(gfw:minimum-size lb2) size))
(setf (gfw:items-of lb1) *list-box-test-data*)
- (gfw:update-from-items lb1)
(gfw:delete-all lb2)
outer-panel))
Modified: trunk/src/uitoolkit/system/system-utils.lisp
==============================================================================
--- trunk/src/uitoolkit/system/system-utils.lisp (original)
+++ trunk/src/uitoolkit/system/system-utils.lisp Thu Sep 7 01:46:41 2006
@@ -39,6 +39,7 @@
(defun recreate-array (array)
(make-array (array-dimensions array)
+ :element-type (array-element-type array)
:adjustable (adjustable-array-p array)
:fill-pointer (if (array-has-fill-pointer-p array) 0 nil)))
@@ -64,6 +65,15 @@
(dotimes (i (length tmp)) (setf (elt result i) (second (elt tmp i))))))
result))
+(defun pick-elements (lisp-seq indices &optional count)
+ (let ((picks nil))
+ (if (cffi:pointerp indices)
+ (dotimes (i count)
+ (push (elt lisp-seq (mem-aref indices :unsigned-int i)) picks))
+ (dotimes (i (length indices))
+ (push (elt lisp-seq (elt indices i)) picks)))
+ (reverse picks)))
+
(defun flatten (tree)
(if (cl:atom tree)
(list tree)
Modified: trunk/src/uitoolkit/widgets/item-manager.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/item-manager.lisp (original)
+++ trunk/src/uitoolkit/widgets/item-manager.lisp Thu Sep 7 01:46:41 2006
@@ -37,6 +37,9 @@
;;; helper functions
;;;
+(defun make-items-array (&optional (count 7))
+ (make-array count :fill-pointer 0 :adjustable t))
+
(defun call-text-provider (manager thing)
(let ((func (text-provider-of manager))
(*print-readably* nil))
@@ -51,7 +54,7 @@
(defun copy-item-sequence (parent new-items item-class)
(let ((hwnd (gfs:handle parent))
(tc (thread-context))
- (replacements (make-array 7 :fill-pointer 0 :adjustable t)))
+ (replacements (make-items-array)))
(cond
((null new-items)
replacements)
@@ -85,10 +88,10 @@
(error 'gfs:disposed-error)))
(defmethod delete-all ((self item-manager))
- (let ((items (items-of self)))
+ (let ((items (slot-value self 'items)))
(dotimes (i (length items))
(gfs:dispose (aref items i))))
- (setf (items-of self) (make-array 7 :fill-pointer 0 :adjustable t)))
+ (setf (slot-value self 'items) (make-items-array)))
(defmethod delete-item :before ((self item-manager) index)
(declare (ignore index))
@@ -96,9 +99,9 @@
(error 'gfs:disposed-error)))
(defmethod delete-item ((self item-manager) index)
- (let* ((items (items-of self))
+ (let* ((items (slot-value self 'items))
(it (elt items index)))
- (setf (items-of self) (remove it items :test #'items-equal-p))
+ (setf (slot-value self 'items) (remove it items :test #'items-equal-p))
(if (gfs:disposed-p it)
(error 'gfs:disposed-error))
(gfs:dispose it)))
@@ -113,7 +116,7 @@
(delete-item self (gfs:span-start sp))))
(defmethod gfs:dispose ((self item-manager))
- (let ((items (items-of self))
+ (let ((items (slot-value self 'items))
(tc (thread-context)))
(dotimes (i (length items))
(delete-tc-item tc (elt items i)))))
@@ -124,11 +127,23 @@
(error 'gfs:disposed-error)))
(defmethod item-index ((self item-manager) (it item))
- (let ((pos (position it (items-of self) :test #'items-equal-p)))
+ (let ((pos (position it (slot-value self 'items) :test #'items-equal-p)))
(if (null pos)
(return-from item-index 0))
0))
+(defmethod items-of ((self item-manager))
+ (coerce (slot-value self 'items) 'list))
+
+(defmethod selected-items :before ((self item-manager))
+ (if (gfs:disposed-p self)
+ (error 'gfs:disposed-error)))
+
+(defmethod (setf selected-items) :before (items (self item-manager))
+ (declare (ignore items))
+ (if (gfs:disposed-p self)
+ (error 'gfs:disposed-error)))
+
(defmethod update-from-items :before ((self item-manager))
(if (gfs:disposed-p self)
(error 'gfs:disposed-error)))
Modified: trunk/src/uitoolkit/widgets/item.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/item.lisp (original)
+++ trunk/src/uitoolkit/widgets/item.lisp Thu Sep 7 01:46:41 2006
@@ -38,15 +38,14 @@
;;;
(defun create-item-with-callback (howner class-symbol thing disp)
- (let ((item nil)
- (id (increment-item-id (thread-context))))
+ (let ((item nil))
(cond
((null disp)
- (setf item (make-instance class-symbol :item-id id :data thing :handle howner)))
+ (setf item (make-instance class-symbol :data thing :handle howner)))
((functionp disp)
- (setf item (make-instance class-symbol :item-id id :data thing :handle howner :callback disp)))
+ (setf item (make-instance class-symbol :data thing :handle howner :callback disp)))
((typep disp 'gfw:event-dispatcher)
- (setf item (make-instance class-symbol :item-id id :data thing :handle howner :dispatcher disp)))
+ (setf item (make-instance class-symbol :data thing :handle howner :dispatcher disp)))
(t
(error 'gfs:toolkit-error
:detail "callback must be a function, instance of gfw:event-dispatcher, or null")))
@@ -70,12 +69,19 @@
(defmethod gfs:dispose ((self item))
(setf (dispatcher self) nil)
+ (let ((hwnd (gfs:handle self)))
+ (unless (or (null hwnd) (cffi:null-pointer-p hwnd))
+ (let ((owner (get-widget (thread-context) hwnd)))
+ (if owner
+ (setf (slot-value owner 'items)
+ (remove self (slot-value owner 'items) :test #'items-equal-p))))))
(delete-tc-item (thread-context) self)
(setf (data-of self) nil)
(setf (item-id self) 0)
(setf (slot-value self 'gfs:handle) nil))
(defmethod initialize-instance :after ((self item) &key callback &allow-other-keys)
+ (setf (item-id self) (increment-item-id (thread-context)))
(when callback
(unless (typep callback 'function)
(error 'gfs:toolkit-error :detail ":callback value must be a function"))
Modified: trunk/src/uitoolkit/widgets/list-box.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/list-box.lisp (original)
+++ trunk/src/uitoolkit/widgets/list-box.lisp Thu Sep 7 01:46:41 2006
@@ -52,11 +52,9 @@
(lognot (logior gfs::+lbs-multiplesel+ gfs::+lbs-extendedsel+))))
(logior orig-flags gfs::+lbs-nosel+))
-(defun lb-init-storage (hwnd item-count total-bytes)
- (gfs::send-message hwnd gfs::+lb-initstorage+ item-count total-bytes))
-
-(defun lb-clear-content (hwnd)
- (gfs::send-message hwnd gfs::+lb-resetcontent+ 0 0))
+(defun lb-single-select-flags (orig-flags)
+ (logand orig-flags
+ (lognot (logior gfs::+lbs-nosel+ gfs::+lbs-extendedsel+ gfs::+lbs-multiplesel+))))
(defun lb-width (hwnd)
(let ((width (gfs::send-message hwnd gfs::+lb-gethorizontalextent+ 0 0)))
@@ -70,6 +68,14 @@
(error 'gfs:win32-error :detail "LB_GETCOUNT failed"))
count))
+(defun lb-delete-all (lb)
+ (let ((old-items (slot-value lb 'items)))
+ (gfs::send-message (gfs:handle lb) gfs::+lb-resetcontent+ 0 0)
+ (dotimes (i (length old-items))
+ (let ((victim (elt old-items i)))
+ (setf (slot-value victim 'gfs:handle) nil)
+ (gfs:dispose victim)))))
+
;;;
;;; methods
;;;
@@ -82,7 +88,7 @@
(item (create-item-with-callback hcontrol 'list-item thing disp)))
(lb-insert-item hcontrol #xFFFFFFFF text (cffi:null-pointer))
(put-item tc item)
- (vector-push-extend item (items-of self))
+ (vector-push-extend item (slot-value self 'items))
item))
(defmethod compute-style-flags ((self list-box) &rest extra-data)
@@ -97,6 +103,7 @@
(:extend-select (setf std-flags (lb-extend-select-flags std-flags)))
(:multiple-select (setf std-flags (lb-multi-select-flags std-flags)))
(:no-select (setf std-flags (lb-no-select-flags std-flags)))
+ (:single-select (setf std-flags (lb-single-select-flags std-flags)))
;; styles that can be combined
;;
@@ -105,6 +112,10 @@
(:want-scrollbar (setf std-flags (logior std-flags gfs::+lbs-disablenoscroll+)))))
(values std-flags 0)))
+(defmethod delete-all ((self list-box))
+ (lb-delete-all self)
+ (setf (slot-value self 'items) (make-items-array)))
+
(defmethod initialize-instance :after ((self list-box) &key estimated-count items parent &allow-other-keys)
(initialize-comctl-classes gfs::+icc-standard-classes+)
(multiple-value-bind (std-style ex-style)
@@ -115,23 +126,19 @@
std-style
ex-style
(increment-widget-id (thread-context)))))
- (setf (slot-value self 'gfs:handle) hwnd)))
- (init-control self)
- (if (and estimated-count (> estimated-count 0))
- (lb-init-storage (gfs:handle self) estimated-count (* estimated-count +estimated-text-size+)))
+ (setf (slot-value self 'gfs:handle) hwnd)
+ (init-control self)
+ (if (and estimated-count (> estimated-count 0))
+ (gfs::send-message hwnd
+ gfs::+lb-initstorage+
+ estimated-count
+ (* estimated-count +estimated-text-size+)))))
(if items
(setf (slot-value self 'items) (copy-item-sequence self items 'list-item)))
(update-from-items self))
-(defmethod (setf items-of) :before (new-items (self list-box))
- (declare (ignore new-items))
- (let ((old-items (items-of self)))
- (dotimes (i (length old-items))
- (let ((victim (elt old-items i)))
- (setf (slot-value victim 'gfs:handle) nil)
- (gfs:dispose victim)))))
-
-(defmethod (setf items-of) :after (new-items (self list-box))
+(defmethod (setf items-of) (new-items (self list-box))
+ (lb-delete-all self)
(setf (slot-value self 'items) (copy-item-sequence self new-items 'list-item))
(update-from-items self))
@@ -180,15 +187,38 @@
(incf (gfs:size-width size) (vertical-scrollbar-width)))
size))
+(defmethod selected-count ((self list-box))
+ (let ((hwnd (gfs:handle self)))
+ (if (test-native-style self gfs::+lbs-nosel+)
+ (if (>= (gfs::send-message hwnd gfs::+lb-getcursel+ 0 0) 0) 1 0)
+ (let ((count (gfs::send-message hwnd gfs::+lb-getselcount+ 0 0)))
+ (if (< count 0) 0 count)))))
+
+(defmethod selected-items ((self list-box))
+ (let ((hwnd (gfs:handle self))
+ (items (slot-value self 'items)))
+ (if (and (not (test-native-style self gfs::+lbs-extendedsel+))
+ (not (test-native-style self gfs::+lbs-multiplesel+)))
+ (let ((index (gfs::send-message hwnd gfs::+lb-getcursel+ 0 0)))
+ (if (and (>= index 0) (< index (length items)))
+ (list (elt items index))
+ nil))
+ (let ((count (gfs::send-message hwnd gfs::+lb-getselcount+ 0 0)))
+ (if (<= count 0)
+ nil
+ (cffi:with-foreign-object (indices :unsigned-int count)
+ (if (/= (gfs::send-message hwnd gfs::+lb-getselitems+ count (cffi:pointer-address indices)) count)
+ nil
+ (gfs::pick-elements items indices count))))))))
+
(defmethod update-from-items ((self list-box))
(let ((sort-func (sort-predicate-of self))
(hwnd (gfs:handle self)))
(when sort-func
- (setf (slot-value self 'items) (gfs::indexed-sort (items-of self) sort-func #'data-of)))
+ (setf (slot-value self 'items) (gfs::indexed-sort (slot-value self 'items) sort-func #'data-of)))
(enable-redraw self nil)
(unwind-protect
- (let ((items (items-of self)))
- (lb-clear-content hwnd)
+ (let ((items (slot-value self 'items)))
(dotimes (index (length items))
(let* ((item (elt items index))
(text (call-text-provider self (data-of item))))
Modified: trunk/src/uitoolkit/widgets/list-item.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/list-item.lisp (original)
+++ trunk/src/uitoolkit/widgets/list-item.lisp Thu Sep 7 01:46:41 2006
@@ -70,6 +70,7 @@
;;;
(defmethod gfs:dispose ((self list-item))
+(print self)
(let ((index (index-of self))
(howner (gfs:handle self)))
(if howner
Modified: trunk/src/uitoolkit/widgets/menu.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/menu.lisp (original)
+++ trunk/src/uitoolkit/widgets/menu.lisp Thu Sep 7 01:46:41 2006
@@ -79,8 +79,8 @@
nil)))
(defun visit-menu-tree (menu fn)
- (dotimes (index (length (items-of menu)))
- (let ((it (elt (items-of menu) index))
+ (dotimes (index (length (slot-value menu 'items)))
+ (let ((it (elt (slot-value menu 'items) index))
(child (sub-menu menu index)))
(unless (null child)
(visit-menu-tree child fn))
@@ -97,32 +97,30 @@
(text (call-text-provider self thing)))
(append-menuitem hmenu (item-id item) text (cffi:null-pointer) (cffi:null-pointer) disabled checked)
(put-item tc item)
- (vector-push-extend item (items-of self))
+ (vector-push-extend item (slot-value self 'items))
item))
(defmethod append-separator ((self menu))
(if (gfs:disposed-p self)
(error 'gfs:disposed-error))
(let* ((tc (thread-context))
- (id (increment-item-id tc))
(hmenu (gfs:handle self))
- (item (make-instance 'menu-item :handle hmenu :item-id id)))
- (append-menuitem hmenu id nil (cffi:null-pointer) (cffi:null-pointer) nil nil)
+ (item (make-instance 'menu-item :handle hmenu)))
+ (append-menuitem hmenu (item-id item) nil (cffi:null-pointer) (cffi:null-pointer) nil nil)
(put-item tc item)
- (vector-push-extend item (items-of self))
+ (vector-push-extend item (slot-value self 'items))
item))
(defmethod append-submenu ((self menu) text (submenu menu) disp &optional disabled checked)
(if (or (gfs:disposed-p self) (gfs:disposed-p submenu))
(error 'gfs:disposed-error))
(let* ((tc (thread-context))
- (id (increment-item-id tc))
(hparent (gfs:handle self))
(hmenu (gfs:handle submenu))
- (item (make-instance 'menu-item :handle hparent :item-id id)))
- (append-menuitem hparent id text (cffi:null-pointer) hmenu disabled checked)
+ (item (make-instance 'menu-item :handle hparent)))
+ (append-menuitem hparent (item-id item) text (cffi:null-pointer) hmenu disabled checked)
(put-item tc item)
- (vector-push-extend item (items-of self))
+ (vector-push-extend item (slot-value self 'items))
(put-widget tc submenu)
(cond
((null disp))
Modified: trunk/src/uitoolkit/widgets/widget-classes.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/widget-classes.lisp (original)
+++ trunk/src/uitoolkit/widgets/widget-classes.lisp Thu Sep 7 01:46:41 2006
@@ -170,7 +170,6 @@
:initarg :sort-predicate
:initform nil)
(items
- :accessor items-of
;; FIXME: allow subclasses to set initial size?
:initform (make-array 7 :fill-pointer 0 :adjustable t))
(text-provider
Modified: trunk/src/uitoolkit/widgets/widget.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/widget.lisp (original)
+++ trunk/src/uitoolkit/widgets/widget.lisp Thu Sep 7 01:46:41 2006
@@ -347,15 +347,6 @@
(if (gfs:disposed-p self)
(error 'gfs:disposed-error)))
-(defmethod selected-items :before ((self widget))
- (if (gfs:disposed-p self)
- (error 'gfs:disposed-error)))
-
-(defmethod (setf selected-items) :before (items (self widget))
- (declare (ignore items))
- (if (gfs:disposed-p self)
- (error 'gfs:disposed-error)))
-
(defmethod selected-p :before ((self widget))
(if (gfs:disposed-p self)
(error 'gfs:disposed-error)))
More information about the Graphic-forms-cvs
mailing list