Author: junrue Date: Mon Jul 10 17:26:44 2006 New Revision: 190 Modified: trunk/docs/manual/api.texinfo trunk/src/demos/textedit/textedit-window.lisp trunk/src/packages.lisp trunk/src/uitoolkit/widgets/edit.lisp trunk/src/uitoolkit/widgets/widget-generics.lisp trunk/src/uitoolkit/widgets/widget.lisp Log: defined widget functions for querying undo and redo state, and implemented them for edit controls Modified: trunk/docs/manual/api.texinfo ============================================================================== --- trunk/docs/manual/api.texinfo (original) +++ trunk/docs/manual/api.texinfo Mon Jul 10 17:26:44 2006 @@ -1525,6 +1525,11 @@ display; nil otherwise. @end deffn +@deffn GenericFunction redo-available-p self => boolean +Returns T if @code{self} has @sc{redo} capability and has an +operation that can be redone; @sc{nil} otherwise. +@end deffn + @deffn GenericFunction redraw self Causes the entire bounds of the object to be marked as needing to be redrawn @end deffn @@ -1583,6 +1588,11 @@ other cases there is no text component at all. @end deffn +@deffn GenericFunction undo-available-p self => boolean +Returns T if @code{self} has @sc{undo} capability and has an +operation that can be undone; @sc{nil} otherwise. +@end deffn + @deffn GenericFunction update self Forces all outstanding paint requests for the object to be processed before this function returns. Modified: trunk/src/demos/textedit/textedit-window.lisp ============================================================================== --- trunk/src/demos/textedit/textedit-window.lisp (original) +++ trunk/src/demos/textedit/textedit-window.lisp Mon Jul 10 17:26:44 2006 @@ -86,6 +86,13 @@ (setf *textedit-win* nil) (gfw:shutdown 0)) +(defun manage-textedit-edit-menu (disp menu) + (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*)))) + (defun textedit-font (disp item) (declare (ignore disp item)) (gfw:with-graphics-context (gc *textedit-control*) @@ -175,7 +182,7 @@ (cells:defobserver file-path ((self textedit-document)) (if *textedit-win* - (setf (gfw:text *textedit-win*) (format nil "~s - GraphicForms TextEdit" (file-path self))) + (setf (gfw:text *textedit-win*) (format nil "~a - GraphicForms TextEdit" (file-path self))) (setf (gfw:text *textedit-win*) "new file - GraphicForms TextEdit"))) (defun textedit-startup () @@ -186,21 +193,21 @@ (let ((menubar (gfw:defmenu ((:item "&File" :callback #'manage-textedit-file-menu :submenu ((:item "&New" :callback #'textedit-file-new) (:item "&Open..." :callback #'textedit-file-open) - (:item "&Save" :callback #'textedit-file-save :disabled) + (:item "&Save" :callback #'textedit-file-save :disabled) (:item "Save &As..." :callback #'textedit-file-save-as) (:item "" :separator) (:item "E&xit" :callback #'textedit-file-quit))) - (:item "&Edit" - :submenu ((:item "&Undo") + (:item "&Edit" :callback #'manage-textedit-edit-menu + :submenu ((:item "&Undo" :callback #'textedit-edit-undo :disabled) (:item "" :separator) - (:item "Cu&t") - (:item "&Copy") - (:item "&Paste") - (:item "De&lete") + (:item "Cu&t" :callback #'textedit-edit-cut :disabled) + (:item "&Copy" :callback #'textedit-edit-copy :disabled) + (:item "&Paste" :callback #'textedit-edit-paste :disabled) + (:item "De&lete" :callback #'textedit-edit-delete :disabled) (:item "" :separator) (:item "&Find...") - (:item "Find &Next") - (:item "&Replace...") + (:item "Find &Next" :disabled) + (:item "&Replace..." :disabled) (:item "&Go To...") (:item "" :separator) (:item "Select &All"))) Modified: trunk/src/packages.lisp ============================================================================== --- trunk/src/packages.lisp (original) +++ trunk/src/packages.lisp Mon Jul 10 17:26:44 2006 @@ -496,6 +496,7 @@ #:traverse #:traverse-order #:trim-sizes + #:undo-available-p #:update #:vertical-scrollbar #:visible-item-count Modified: trunk/src/uitoolkit/widgets/edit.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/edit.lisp (original) +++ trunk/src/uitoolkit/widgets/edit.lisp Mon Jul 10 17:26:44 2006 @@ -132,3 +132,6 @@ (defmethod (setf text-modified-p) (flag (self edit)) (gfs::send-message (gfs:handle self) gfs::+em-setmodify+ (if flag 1 0) 0)) + +(defmethod undo-available-p ((self edit)) + (/= (gfs::send-message (gfs:handle self) gfs::+em-canundo+ 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 Mon Jul 10 17:26:44 2006 @@ -270,6 +270,9 @@ (defgeneric preferred-size (self width-hint height-hint) (:documentation "Returns a size object representing the object's 'preferred' size.")) +(defgeneric redo-available-p (self) + (:documentation "Returns T if self can redo an operation; nil otherwise.")) + (defgeneric redraw (self) (:documentation "Causes the entire bounds of the object to be marked as needing to be redrawn")) @@ -375,6 +378,9 @@ (defgeneric traverse-order (self) (:documentation "Returns a list of this object's layout-managed children in the order in which tab traversal would visit them.")) +(defgeneric undo-available-p (self) + (:documentation "Returns T if self can undo an operation; nil otherwise.")) + (defgeneric update (self) (:documentation "Forces all outstanding paint requests for the object to be processed before this function returns.")) Modified: trunk/src/uitoolkit/widgets/widget.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget.lisp (original) +++ trunk/src/uitoolkit/widgets/widget.lisp Mon Jul 10 17:26:44 2006 @@ -259,6 +259,13 @@ (format stream "handle: ~x " (gfs:handle self)) (format stream "dispatcher: ~a " (dispatcher self)))) +(defmethod redo-available-p :before ((self widget)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error))) + +(defmethod redo-available-p ((self widget)) + nil) + (defmethod redraw :before ((self widget)) (if (gfs:disposed-p self) (error 'gfs:disposed-error))) @@ -328,6 +335,13 @@ (if (gfs:disposed-p self) (error 'gfs:disposed-error))) +(defmethod undo-available-p :before ((self widget)) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error))) + +(defmethod undo-available-p ((self widget)) + nil) + (defmethod update :before ((w widget)) (if (gfs:disposed-p w) (error 'gfs:disposed-error)))