Author: junrue Date: Tue Jul 11 01:24:41 2006 New Revision: 191

Modified: trunk/docs/manual/api.texinfo trunk/src/demos/textedit/textedit-window.lisp trunk/src/packages.lisp trunk/src/uitoolkit/system/datastructs.lisp trunk/src/uitoolkit/system/system-constants.lisp trunk/src/uitoolkit/system/user32.lisp trunk/src/uitoolkit/widgets/edit.lisp trunk/src/uitoolkit/widgets/widget-generics.lisp trunk/src/uitoolkit/widgets/widget-utils.lisp trunk/src/uitoolkit/widgets/widget-with-items.lisp trunk/src/uitoolkit/widgets/widget.lisp Log: defined and implemented sufficient new methods to implement edit control cut/copy/paste/delete functionality for a window Edit menu; full-blown general clipboard support is still down the road a bit

Modified: trunk/docs/manual/api.texinfo ============================================================================== --- trunk/docs/manual/api.texinfo (original) +++ trunk/docs/manual/api.texinfo Tue Jul 11 01:24:41 2006 @@ -117,13 +117,18 @@

@deffn GenericFunction disposed-p self Returns T if @ref{dispose} has been called on @var{self} and the -object has not since been re-initialized; returns nil otherwise. -This function also returns T if @var{self} has been instantiated -but secondary initialization code has not yet executed. +object has not since been re-initialized; returns @sc{nil} otherwise. +This function also returns T if @var{self} has been instantiated but +secondary initialization code has not yet executed. @end deffn

+@defun empty-span-p span +Returns T if the @var{start} and @var{end} of @code{span} are the same; +@sc{nil} otherwise. +@end defun + @deffn Macro location rect -This macro returns the @code{location} slot of a @ref{rectangle}. +This macro returns the @var{location} slot of a @ref{rectangle}. @end deffn

@deffn Function make-point :x :y :z @@ -1276,12 +1281,24 @@ Returns T if the object is in the checked state; nil otherwise. @end deffn

+@deffn GenericFunction clear-all self +Clears all content from @code{self}. +@end deffn + @deffn GenericFunction clear-item self index -Clears the item at the zero-based index. +Clears the @ref{item} at the zero-based @var{index}. +@end deffn + +@deffn GenericFunction clear-selection self +Sets the selection status of @code{self} to @samp{not selected} or +@samp{empty}. For a @ref{control} with a text field component, +such as an @ref{edit} control, this function deletes selected +text. @end deffn

-@deffn GenericFunction clear-span self sp -Clears the items whose zero-based indices lie within the specified span. +@deffn GenericFunction clear-span self @ref{span} +Clears the items from @var{self} whose zero-based indices lie within +the specified @var{span}. @end deffn

@deffn GenericFunction client-size self @@ -1300,6 +1317,32 @@ enclose the specified desired client area and this object's trim. @end deffn

+@anchor{copy-text} +@deffn GenericFunction copy-text self +This function is a shortcut for a common clipboard transfer operation, +namely the transfer of text from @code{self} to the system clipboard. +The existing content of @code{self} remains in place. Some @ref{control}s +like the @ref{edit} control have built-in clipboard functionality, and +in such cases, the implementation of this function delegates directly. +See @ref{cut-text}, @ref{paste-text}, and @ref{text-for-pasting-p}.@*@* +@strong{Note:} an upcoming release will include more general +infrastructure for clipboard operations. +@end deffn + +@anchor{cut-text} +@deffn GenericFunction cut-text self +This function is a shortcut for a common clipboard transfer operation, +namely the transfer of text from @code{self} to the system clipboard +and removal of content from @code{self}. Some @ref{control}s like the +@ref{edit} control have built-in clipboard functionality, and in such +cases, the implementation of this function delegates directly. For +other @ref{widget}s, this operation is a wrapper around a copy/delete +sequence. See @ref{copy-text}, @ref{paste-text}, and +@ref{text-for-pasting-p}.@*@* +@strong{Note:} an upcoming release will +include more general infrastructure for clipboard operations. +@end deffn + @deffn GenericFunction default-widget self Returns the default @ref{widget} set for a @ref{dialog}, or @sc{nil} if none has been set. If @sc{nil} is passed to the corresponding @@ -1509,6 +1552,19 @@ @end quotation @end deffn

+@anchor{paste-text} +@deffn GenericFunction paste-text self +This function is a shortcut for a common clipboard transfer operation, +namely the transfer of text from the system clipboard to @code{self}. +Depending on the current selection within @code{self}, the text either +gets inserted or existing content is replaced. Some @ref{control}s like the +@ref{edit} control have built-in clipboard functionality, and in such +cases, the implementation of this function delegates directly. See +@ref{copy-text}, @ref{cut-text}, and @ref{text-for-pasting-p}.@*@* +@strong{Note:} an upcoming release will include more +general infrastructure for clipboard operations. +@end deffn + @anchor{preferred-size} @deffn GenericFunction preferred-size self width-hint height-hint Implement this function to return @code{self}'s preferred @ref{size}; @@ -1550,6 +1606,12 @@ decorations are modified appropriately. @end deffn

+@deffn GenericFunction selection-span self => @ref{span} +Returns a span object describing the start and end of the selection +within @var{self}. If there is no selection, this function returns +@sc{nil}. +@end deffn + @anchor{show} @deffn GenericFunction show self flag Causes the object to be visible or hidden on the screen, but not @@ -1579,6 +1641,16 @@ the custom control will be managed by a @ref{layout-manager}. @end deffn

+@anchor{text-for-pasting-p} +@deffn GenericFunction text-for-pasting-p self +This function is a shortcut means of checking the clipboard for existence +of data of a specific type (text). This status information is typically +used to enable or disable a @samp{Paste} menu item. See @ref{copy-text}, +@ref{cut-text}, and @ref{paste-text}.@*@* +@strong{Note:} an upcoming release will include more general +infrastructure for clipboard operations. +@end deffn + @anchor{text-modified-p} @deffn GenericFunction text-modified-p self Returns T if the text component of @code{self} has been modified by

Modified: trunk/src/demos/textedit/textedit-window.lisp ============================================================================== --- trunk/src/demos/textedit/textedit-window.lisp (original) +++ trunk/src/demos/textedit/textedit-window.lisp Tue Jul 11 01:24:41 2006 @@ -90,8 +90,32 @@ (declare (ignore disp)) (unless *textedit-control* (return-from manage-textedit-edit-menu nil)) - (let ((items (gfw:items menu))) - (gfw:enable (elt items 0) (gfw:undo-available-p *textedit-control*)))) + (let ((items (gfw:items menu)) + (text-sel (gfw:selection-span *textedit-control*))) + (gfw:enable (elt items 0) (gfw:undo-available-p *textedit-control*)) + (gfw:enable (elt items 2) text-sel) + (gfw:enable (elt items 3) text-sel) + (gfw:enable (elt items 4) (gfw:text-for-pasting-p *textedit-control*)) + (gfw:enable (elt items 5) text-sel))) + +(defun textedit-edit-copy (disp item) + (declare (ignore disp item)) + (gfw:copy-text *textedit-control*)) + +(defun textedit-edit-cut (disp item) + (declare (ignore disp item)) + (gfw:cut-text *textedit-control*)) + +(defun textedit-edit-delete (disp item) + (declare (ignore disp item)) + (gfw:clear-selection *textedit-control*)) + +(defun textedit-edit-paste (disp item) + (declare (ignore disp item)) + (gfw:paste-text *textedit-control*)) + +(defun textedit-edit-undo (disp item) + (declare (ignore disp item)))

(defun textedit-font (disp item) (declare (ignore disp item))

Modified: trunk/src/packages.lisp ============================================================================== --- trunk/src/packages.lisp (original) +++ trunk/src/packages.lisp Tue Jul 11 01:24:41 2006 @@ -65,6 +65,7 @@ #:detail #:dispose #:disposed-p + #:empty-span-p #:equal-size-p #:flatten #:handle @@ -343,11 +344,11 @@ #:column-order #:columns #:compute-outer-size - #:copy #:copy-area + #:copy-text + #:cut-text #:current-font #:cursor - #:cut #:default-message-filter #:default-widget #:defmenu @@ -447,7 +448,7 @@ #:pack #:page-increment #:parent - #:paste + #:paste-text #:peer #:preferred-size #:primary-p @@ -485,6 +486,7 @@ #:sub-menu #:text #:text-baseline + #:text-for-pasting-p #:text-height #:text-limit #:text-modified-p

Modified: trunk/src/uitoolkit/system/datastructs.lisp ============================================================================== --- trunk/src/uitoolkit/system/datastructs.lisp (original) +++ trunk/src/uitoolkit/system/datastructs.lisp Tue Jul 11 01:24:41 2006 @@ -47,6 +47,9 @@ (defmacro size (rect) `(rectangle-size ,rect))

+(defun empty-span-p (span) + (= (span-start span) (span-end span))) + (defun equal-size-p (size1 size2) (and (= (size-width size1) (size-width size2)) (= (size-height size1) (size-height size2))))

Modified: trunk/src/uitoolkit/system/system-constants.lisp ============================================================================== --- trunk/src/uitoolkit/system/system-constants.lisp (original) +++ trunk/src/uitoolkit/system/system-constants.lisp Tue Jul 11 01:24:41 2006 @@ -142,6 +142,30 @@ (defconstant +cderr-nohook+ #x000B) (defconstant +cderr-registermsgfail+ #x000C)

+;;; +;;; clipboard-related constants +;;; +(defconstant +cf-text+ 1) +(defconstant +cf-bitmap+ 2) +(defconstant +cf-metafilepict+ 3) +(defconstant +cf-sylk+ 4) +(defconstant +cf-dif+ 5) +(defconstant +cf-tiff+ 6) +(defconstant +cf-oemtext+ 7) +(defconstant +cf-dib+ 8) +(defconstant +cf-palette+ 9) +(defconstant +cf-pendata+ 10) +(defconstant +cf-riff+ 11) +(defconstant +cf-wave+ 12) +(defconstant +cf-unicodetext+ 13) +(defconstant +cf-enhmetafile+ 14) +(defconstant +cf-hdrop+ 15) +(defconstant +cf-locale+ 16) +(defconstant +cf-dibv5+ 17) + +;;; +;;; font-related constants +;;; (defconstant +cf-screenfonts+ #x00000001) (defconstant +cf-printerfonts+ #x00000002) (defconstant +cf-both+ #x00000003) @@ -985,6 +1009,29 @@ (defconstant +wm-mousehover+ #x02A1) (defconstant +wm-ncmouseleave+ #x02A2) (defconstant +wm-mouseleave+ #x02A3) +(defconstant +wm-cut+ #x0300) +(defconstant +wm-copy+ #x0301) +(defconstant +wm-paste+ #x0302) +(defconstant +wm-clear+ #x0303) +(defconstant +wm-undo+ #x0304) +(defconstant +wm-renderformat+ #x0305) +(defconstant +wm-renderallformats+ #x0306) +(defconstant +wm-destroyclipboard+ #x0307) +(defconstant +wm-drawclipboard+ #x0308) +(defconstant +wm-paintclipboard+ #x0309) +(defconstant +wm-vscrollclipboard+ #x030A) +(defconstant +wm-sizeclipboard+ #x030B) +(defconstant +wm-askcbformatname+ #x030C) +(defconstant +wm-changecbchain+ #x030D) +(defconstant +wm-hscrollclipboard+ #x030E) +(defconstant +wm-querynewpalette+ #x030F) +(defconstant +wm-paletteischanging+ #x0310) +(defconstant +wm-palettechanged+ #x0311) +(defconstant +wm-hotkey+ #x0312) +(defconstant +wm-print+ #x0317) +(defconstant +wm-printclient+ #x0318) +(defconstant +wm-appcommand+ #x0319) +(defconstant +wm-themechanged+ #x031A) (defconstant +wm-user-base+ #x0400) (defconstant +wm-app-base+ #x8000)

Modified: trunk/src/uitoolkit/system/user32.lisp ============================================================================== --- trunk/src/uitoolkit/system/user32.lisp (original) +++ trunk/src/uitoolkit/system/user32.lisp Tue Jul 11 01:24:41 2006 @@ -454,6 +454,11 @@ (erase BOOL))

(defcfun + ("IsClipboardFormatAvailable" is-clipboard-format-available) + BOOL + (format UINT)) + +(defcfun ("IsDialogMessageA" is-dialog-message) BOOL (hwnd HANDLE)

Modified: trunk/src/uitoolkit/widgets/edit.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/edit.lisp (original) +++ trunk/src/uitoolkit/widgets/edit.lisp Tue Jul 11 01:24:41 2006 @@ -48,6 +48,9 @@ (let ((bits (gfs::get-window-long (gfs:handle self) gfs::+gwl-style+))) (= (logand bits gfs::+es-autovscroll+) gfs::+es-autovscroll+)))

+(defmethod clear-selection ((self edit)) + (gfs::send-message (gfs:handle self) gfs::+wm-clear+ 0 0)) + (defmethod compute-style-flags ((self edit) &rest extra-data) (declare (ignore extra-data)) (let ((std-flags (logior +default-child-style+ gfs::+ws-tabstop+)) @@ -74,6 +77,12 @@ (setf std-flags (logior std-flags gfs::+es-autohscroll+))) (values std-flags (if (find :no-border style) 0 gfs::+ws-ex-clientedge+))))

+(defmethod copy-text ((self edit)) + (gfs::send-message (gfs:handle self) gfs::+wm-copy+ 0 0)) + +(defmethod cut-text ((self edit)) + (gfs::send-message (gfs:handle self) gfs::+wm-cut+ 0 0)) + (defmethod enable-scrollbars ((self edit) horizontal vertical) (let ((bits (gfs::get-window-long (gfs:handle self) gfs::+gwl-style+))) (if horizontal @@ -102,6 +111,9 @@ (error 'gfs:disposed-error)) (gfs::send-message (gfs:handle self) gfs::+em-getlinecount+ 0 0))

+(defmethod paste-text ((self edit)) + (gfs::send-message (gfs:handle self) gfs::+wm-paste+ 0 0)) + (defmethod preferred-size ((self edit) width-hint height-hint) (let ((text-size (widget-text-size self (logior gfs::+dt-editcontrol+ gfs::+dt-noprefix+))) (size (gfs:make-size)) @@ -118,6 +130,17 @@ (* +vertical-edit-text-margin+ 2)))) size))

+(defmethod selection-span ((self edit)) + (cffi:with-foreign-object (start-ptr :unsigned-long) + (cffi:with-foreign-object (end-ptr :unsigned-long) + (gfs::send-message (gfs:handle self) + gfs::+em-getsel+ + (cffi:pointer-address start-ptr) + (cffi:pointer-address end-ptr)) + (let ((start (cffi:mem-ref start-ptr :unsigned-long)) + (end (cffi:mem-ref end-ptr :unsigned-long))) + (if (= start end) nil (gfs:make-span :start start :end end)))))) + (defmethod text ((self edit)) (get-widget-text self))

@@ -127,6 +150,9 @@ (defmethod text-baseline ((self edit)) (widget-text-baseline self +vertical-edit-text-margin+))

+(defmethod text-for-pasting-p ((self edit)) + (/= (gfs::is-clipboard-format-available gfs::+cf-text+) 0)) + (defmethod text-modified-p ((self edit)) (/= (gfs::send-message (gfs:handle self) gfs::+em-getmodify+ 0 0) 0))

Modified: trunk/src/uitoolkit/widgets/widget-generics.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-generics.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-generics.lisp Tue Jul 11 01:24:41 2006 @@ -84,6 +84,9 @@ (defgeneric checked-p (self) (:documentation "Returns T if the object is in the checked state; nil otherwise."))

+(defgeneric clear-all (self) + (:documentation "Clears all content from self.")) + (defgeneric clear-item (self index) (:documentation "Clears the item at the zero-based index."))

@@ -117,14 +120,14 @@ (defgeneric compute-outer-size (self desired-client-size) (:documentation "Return a size object describing the dimensions of the area required to enclose the specified desired client area and this object's trim."))

-(defgeneric copy (self) - (:documentation "Copies the current selection to the clipboard.")) +(defgeneric copy-text (self) + (:documentation "Copies the current text selection to the clipboard."))

(defgeneric cursor (self) (:documentation "Returns the cursor object associated with this object."))

-(defgeneric cut (self) - (:documentation "Copies the current selection to the clipboard and removes it from the object.")) +(defgeneric cut-text (self) + (:documentation "Copies the current text selection to the clipboard and removes it from self."))

(defgeneric default-widget (self) (:documentation "Returns the child widget or item that has the default emphasis.")) @@ -261,8 +264,8 @@ (defgeneric parent (self) (:documentation "Returns the object's parent."))

-(defgeneric paste (self) - (:documentation "Copies content from the clipboard into the object.")) +(defgeneric paste-text (self) + (:documentation "Copies text from the clipboard into self"))

(defgeneric peer (self) (:documentation "Returns the visual object associated with this object (not the underlying window system handle).")) @@ -322,7 +325,7 @@ (:documentation "Returns a list of zero-based indices identifying the selected items within this object."))

(defgeneric selection-span (self) - (:documentation "Returns a span object describing the start and end indices of the object selection.")) + (:documentation "Returns a span object describing the start and end indices of the selection within self."))

(defgeneric show (self flag) (:documentation "Causes the object to be visible or hidden on the screen, but not necessarily top-most in the display z-order.")) @@ -354,6 +357,9 @@ (defgeneric text-baseline (self) (:documentation "Returns the y coordinate of the object's text component, if any."))

+(defgeneric text-for-pasting-p (self) + (:documentation "Returns T if the clipboard has data in text format; nil otherwise.")) + (defgeneric text-height (self) (:documentation "Returns the height of the object's text field."))

Modified: trunk/src/uitoolkit/widgets/widget-utils.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-utils.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-utils.lisp Tue Jul 11 01:24:41 2006 @@ -91,11 +91,6 @@ (gfg::destroy-magick) (gfs::post-quit-message exit-code))

-(defun clear-all (w) - (let ((count (length (items w)))) - (unless (zerop count) - (gfw:clear-span w (gfs:make-span :start 0 :end (1- count)))))) - (defun initialize-comctl-classes (icc-flags) (cffi:with-foreign-object (ic-ptr 'gfs::initcommoncontrolsex) (cffi:with-foreign-slots ((gfs::size gfs::icc) ic-ptr gfs::initcommoncontrolsex)

Modified: trunk/src/uitoolkit/widgets/widget-with-items.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-with-items.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-with-items.lisp Tue Jul 11 01:24:41 2006 @@ -33,40 +33,45 @@

(in-package :graphic-forms.uitoolkit.widgets)

-(defmethod append-item :before ((w widget-with-items) text (image gfg:image) (disp event-dispatcher) &optional checked disabled) +(defmethod append-item :before ((self widget-with-items) text (image gfg:image) (disp event-dispatcher) &optional checked disabled) (declare (ignore text image disp checked disabled)) - (if (gfs:disposed-p w) + (if (gfs:disposed-p self) (error 'gfs:disposed-error)))

-(defmethod clear-item :before ((w widget-with-items) index) +(defmethod clear-all ((self widget-with-items)) + (let ((count (length (items self)))) + (unless (zerop count) + (clear-span self (gfs:make-span :start 0 :end (1- count)))))) + +(defmethod clear-item :before ((self widget-with-items) index) (declare (ignore index)) - (if (gfs:disposed-p w) + (if (gfs:disposed-p self) (error 'gfs:disposed-error)))

-(defmethod clear-item ((w widget-with-items) index) - (let* ((items (items w)) +(defmethod clear-item ((self widget-with-items) index) + (let* ((items (items self)) (it (elt items index))) - (delete it (items w) :test #'items-equal-p) + (delete it (items self) :test #'items-equal-p) (if (gfs:disposed-p it) (error 'gfs:disposed-error)) (gfs:dispose it)))

-(defmethod clear-span :before ((w widget-with-items) (sp gfs:span)) +(defmethod clear-span :before ((self widget-with-items) (sp gfs:span)) (declare (ignore sp)) - (if (gfs:disposed-p w) + (if (gfs:disposed-p self) (error 'gfs:disposed-error)))

-(defmethod clear-span ((w widget-with-items) (sp gfs:span)) +(defmethod clear-span ((self widget-with-items) (sp gfs:span)) (dotimes (i (1+ (- (gfs:span-end sp) (gfs:span-start sp)))) - (clear-item w (gfs:span-start sp)))) + (clear-item self (gfs:span-start sp))))

-(defmethod item-index :before ((w widget-with-items) (it item)) +(defmethod item-index :before ((self widget-with-items) (it item)) (declare (ignore it)) - (if (gfs:disposed-p w) + (if (gfs:disposed-p self) (error 'gfs:disposed-error)))

-(defmethod item-index ((w widget-with-items) (it item)) - (let ((pos (position it (items w) :test #'items-equal-p))) +(defmethod item-index ((self widget-with-items) (it item)) + (let ((pos (position it (items self) :test #'items-equal-p))) (if (null pos) (return-from item-index 0)) 0))

Modified: trunk/src/uitoolkit/widgets/widget.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget.lisp (original) +++ trunk/src/uitoolkit/widgets/widget.lisp Tue Jul 11 01:24:41 2006 @@ -125,19 +125,27 @@ (defmethod center-on-parent ((self widget)) (center-object (parent self) self))

-(defmethod checked-p :before ((w widget)) - (if (gfs:disposed-p w) +(defmethod checked-p :before ((self widget)) + (if (gfs:disposed-p self) (error 'gfs:disposed-error)))

-(defmethod checked-p ((w widget)) - (declare (ignore w)) +(defmethod checked-p ((self widget)) + (declare (ignore self)) nil)

-(defmethod client-size :before ((w widget)) - (if (gfs:disposed-p w) +(defmethod clear-all :before ((self widget)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error))) + +(defmethod clear-selection :before ((self widget)) + (if (gfs:disposed-p self) (error 'gfs:disposed-error)))

-(defmethod client-size ((w widget)) +(defmethod client-size :before ((self widget)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error))) + +(defmethod client-size ((self widget)) (cffi:with-foreign-object (wi-ptr 'gfs::windowinfo) (cffi:with-foreign-slots ((gfs::cbsize gfs::clientleft @@ -146,19 +154,27 @@ gfs::clientbottom) wi-ptr gfs::windowinfo) (setf gfs::cbsize (cffi::foreign-type-size 'gfs::windowinfo)) - (when (zerop (gfs::get-window-info (gfs:handle w) wi-ptr)) + (when (zerop (gfs::get-window-info (gfs:handle self) wi-ptr)) (error 'gfs:win32-error :detail "get-window-info failed")) (gfs:make-size :width (- gfs::clientright gfs::clientleft) :height (- gfs::clientbottom gfs::clienttop)))))

-(defmethod gfs:dispose ((w widget)) - (unless (null (dispatcher w)) - (event-dispose (dispatcher w) w)) - (let ((hwnd (gfs:handle w))) +(defmethod copy-text :before ((self widget)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error))) + +(defmethod cut-text :before ((self widget)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error))) + +(defmethod gfs:dispose ((self widget)) + (unless (null (dispatcher self)) + (event-dispose (dispatcher self) self)) + (let ((hwnd (gfs:handle self))) (if (not (gfs:null-handle-p hwnd)) (if (zerop (gfs::destroy-window hwnd)) (error 'gfs:win32-error :detail "destroy-window failed")))) - (setf (slot-value w 'gfs:handle) nil)) + (setf (slot-value self 'gfs:handle) nil))

(defmethod enable :before ((self widget) flag) (declare (ignore flag)) @@ -254,6 +270,10 @@ (error 'gfs:toolkit-error :detail "no widget for hwnd"))) widget))

+(defmethod paste-text :before ((self widget)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error))) + (defmethod print-object ((self widget) stream) (print-unreadable-object (self stream :type t) (format stream "handle: ~x " (gfs:handle self)) @@ -290,6 +310,10 @@ (declare (ignore self)) nil)

+(defmethod selection-span :before ((self widget)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error))) + (defmethod size :before ((self widget)) (if (gfs:disposed-p self) (error 'gfs:disposed-error))) @@ -326,6 +350,13 @@ (if (gfs:disposed-p self) (error 'gfs:disposed-error)))

+(defmethod text-for-pasting-p :before ((self widget)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error))) + +(defmethod text-for-pasting-p ((self widget)) + nil) + (defmethod (setf text-modified-p) :before (flag (self widget)) (declare (ignore flag)) (if (gfs:disposed-p self)