[graphic-forms-cvs] r190 - in trunk: docs/manual src src/demos/textedit src/uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Mon Jul 10 21:26:45 UTC 2006
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
+ at 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.
+ at 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
+ at 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.
+ at 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)))
More information about the Graphic-forms-cvs
mailing list