Author: junrue Date: Fri Nov 24 02:01:22 2006 New Revision: 400 Modified: trunk/docs/manual/gfw-symbols.xml trunk/src/tests/mcclim/hello-tester.lisp trunk/src/uitoolkit/system/user32.lisp trunk/src/uitoolkit/widgets/widget-classes.lisp Log: initial work on cursor support Modified: trunk/docs/manual/gfw-symbols.xml ============================================================================== --- trunk/docs/manual/gfw-symbols.xml (original) +++ trunk/docs/manual/gfw-symbols.xml Fri Nov 24 02:01:22 2006 @@ -2195,6 +2195,66 @@ <!-- FUNCTIONS --> + <function name="cursor"> + <syntax with-setf="t"> + <arguments> + <argument name="window"> + <description> + The <reftopic>gfw:window</reftopic> whose cursor is to be + returned (modified). + </description> + </argument> + </arguments> + <return> + <reftopic>gfw:cursor</reftopic> + </return> + </syntax> + <description> + This function returns (sets) the cursor associated with a window. Such + an association remains in effect until either the next call to the + SETF function or the assigned cursor is disposed. + </description> + <seealso> + <reftopic>gfw:show-cursor</reftopic> + <reftopic>gfw:with-cursor</reftopic> + <reftopic>gfw:with-wait-cursor</reftopic> + </seealso> + </function> + + <function name="show-cursor"> + <syntax> + <arguments> + <argument name="window"> + <description> + The <reftopic>gfw:window</reftopic> whose cursor visibility + is to be modified. + </description> + </argument> + <argument name="flag"> + <description> + A <refclhs>boolean</refclhs>; pass NIL to hide the cursor, or + non-NIL to make the cursor visible. + </description> + </argument> + </arguments> + <return> + <emphasis>undefined</emphasis> + </return> + </syntax> + <description> + Use this function to control the visibility of the mouse cursor within + <arg0/>. The system maintains a display counter whose value must be + greater than 0 for the cursor to actually be visible. When <arg1/> is + NIL, then the system counter is decremented by one; when <arg1/> is + non-NIL, the system counter is incremented. + </description> + <seealso> + <reftopic>gfw:cursor</reftopic> + <reftopic>gfw:with-cursor</reftopic> + <reftopic>gfw:with-wait-cursor</reftopic> + </seealso> + </function> + <function name="startup"> <syntax> <arguments> @@ -5912,6 +5972,80 @@ <!-- MACROS --> + <macro name="with-cursor"> + <syntax> + <arguments> + <notarg name="("/> + <argument name="window"> + <description> + The <reftopic>gfw:window</reftopic> object for which the cursor + will be set as determined by <arg1/>. + </description> + </argument> + <argument name="cursor-id"> + <description> + Identifies the cursor to be displayed. See <reftopic>gfw:cursor</reftopic> + for details on what values may be specified for this argument. + </description> + </argument> + <notarg name=")"/> + <notarg name="&body"/> + <argument name="body"> + <description> + Application code. + </description> + </argument> + </arguments> + <return> + <emphasis>results</emphasis> + </return> + </syntax> + <description> + This macro temporarily sets the cursor specified by <arg1/> in <arg0/> + for the duration of <arg2/>. The previous cursor set in + <arg0/> is restored afterwards. + </description> + <seealso> + <reftopic>gfw:with-wait-cursor</reftopic> + <reftopic>gfw:set-cursor</reftopic> + <reftopic>gfw:show-cursor</reftopic> + </seealso> + </macro> + + <macro name="with-wait-cursor"> + <syntax> + <arguments> + <notarg name="("/> + <argument name="window"> + <description> + The <reftopic>gfw:window</reftopic> object for which the cursor + will be set as determined by <arg1/>. + </description> + </argument> + <notarg name=")"/> + <notarg name="&body"/> + <argument name="body"> + <description> + Application code. + </description> + </argument> + </arguments> + <return> + <emphasis>results</emphasis> + </return> + </syntax> + <description> + This macro temporarily sets the wait cursor in <arg0/> + for the duration of <arg1/>. The previous cursor set in + <arg0/> is restored afterwards. + </description> + <seealso> + <reftopic>gfw:with-cursor</reftopic> + <reftopic>gfw:set-cursor</reftopic> + <reftopic>gfw:show-cursor</reftopic> + </seealso> + </macro> + <macro name="with-color-dialog"> <syntax> <arguments> Modified: trunk/src/tests/mcclim/hello-tester.lisp ============================================================================== --- trunk/src/tests/mcclim/hello-tester.lisp (original) +++ trunk/src/tests/mcclim/hello-tester.lisp Fri Nov 24 02:01:22 2006 @@ -13,11 +13,11 @@ (:fill some-pane))))) (define-command com-hello () - (clim-graphic-forms::debug-print "com-hello called ") + #+graphic-forms (gfs::debug-print "com-hello called ") (setf (message *application-frame*) "Hello there!")) (define-command com-hi () - (clim-graphic-forms::debug-print "com-hi called ") + #+graphic-forms (gfs::debug-print "com-hi called ") (setf (message *application-frame*) "Hi there!")) (define-command-table menu-command-table @@ -33,5 +33,5 @@ (frame-exit *application-frame*)) (defmethod display-some-pane ((frame hello-frame) stream) - (clim-graphic-forms::debug-print "display-some-pane called ") + #+graphic-forms (gfs::debug-print "display-some-pane called ") (format stream (message frame))) Modified: trunk/src/uitoolkit/system/user32.lisp ============================================================================== --- trunk/src/uitoolkit/system/user32.lisp (original) +++ trunk/src/uitoolkit/system/user32.lisp Fri Nov 24 02:01:22 2006 @@ -129,6 +129,11 @@ (lp LPARAM)) (defcfun + ("DestroyCursor" destroy-cursor) + BOOL + (hcursor HANDLE)) + +(defcfun ("DestroyIcon" destroy-icon) BOOL (hicon HANDLE)) @@ -670,6 +675,11 @@ (hwnd HANDLE)) (defcfun + ("SetCursor" set-cursor) + HANDLE + (hcursor HANDLE)) + +(defcfun ("SetFocus" set-focus) HANDLE (hwnd HANDLE)) @@ -741,6 +751,11 @@ (str :string)) (defcfun + ("ShowCursor" show-cursor) + INT + (flag BOOL)) + +(defcfun ("ShowWindow" show-window) BOOL (hwnd HANDLE) Modified: trunk/src/uitoolkit/widgets/widget-classes.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-classes.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-classes.lisp Fri Nov 24 02:01:22 2006 @@ -33,6 +33,9 @@ (in-package :graphic-forms.uitoolkit.widgets) +(defclass cursor (gfs:native-object) () + (:documentation "The cursor class represents the sprite controlled by the pointing device.")) + (defclass display (gfs:native-object) () (:documentation "Instances of this class describe characteristics of monitors attached to the system.")) @@ -129,9 +132,6 @@ :initform nil)) (:documentation "The widget class is the base class for all windowed user interface objects.")) -(defclass caret (widget) () - (:documentation "The caret class provides an i-beam typically representing an insertion point.")) - (defclass item-manager () ((sort-predicate :accessor sort-predicate-of