[graphic-forms-cvs] r197 - in trunk: docs/manual etc src src/uitoolkit/system src/uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Fri Jul 14 00:20:13 UTC 2006
Author: junrue
Date: Thu Jul 13 20:20:12 2006
New Revision: 197
Modified:
trunk/docs/manual/api.texinfo
trunk/etc/lisp.exe.manifest
trunk/src/packages.lisp
trunk/src/uitoolkit/system/system-constants.lisp
trunk/src/uitoolkit/widgets/event-generics.lisp
trunk/src/uitoolkit/widgets/event.lisp
Log:
implemented event-session function, currently untested
Modified: trunk/docs/manual/api.texinfo
==============================================================================
--- trunk/docs/manual/api.texinfo (original)
+++ trunk/docs/manual/api.texinfo Thu Jul 13 20:20:12 2006
@@ -1172,6 +1172,57 @@
@end table
@end deffn
+ at anchor{event-session}
+ at deffn GenericFunction event-session dispatcher window phase reason
+Implement this method to participate in the system's session shutdown
+protocol. When the user chooses to end the session (by logging out or
+by shutting down), or if an application calls one of the Win32
+shutdown functions, every application is given a veto option. This
+event function will be called at least once for each @ref{top-level}
+window in the application.@*
+
+The MSDN documentation makes the following recommendations for handling
+this event:
+ at itemize @bullet
+ at item Whenever possible, applications should respect the user's
+intentions by allowing the session to end.
+ at item In the case of a critical operation, provide a @ref{dialog} or
+other feedback with information for the user as to consequences
+if the application is interrupted at this time.
+ at item Respond to the @code{:query} event as quickly as possible, leaving
+time-consuming cleanup to be done in the session @code{:end} event.
+ at end itemize
+
+ at table @var
+ at event-dispatcher-arg
+ at item window
+The @ref{top-level} @ref{window} receiving this event.
+ at item phase
+Identifies which of the two phases this event represents:
+ at table @code
+ at item :query
+This symbol means that the system is querying the application for
+permission to proceed. Return @sc{nil} if there is a reason to veto
+the process, or non- at sc{nil} otherwise.
+ at item :end
+This symbol is specified in the subsequent call to @code{event-session}.
+It means that the system is going ahead with ending the
+session, therefore this is an opportunity for graceful cleanup.
+ at end table
+ at item reason
+Provides more detail to aid in choosing desired behavior:
+ at table @code
+ at item :logoff
+The user is logging off.
+ at item :replacing-file
+The application must exit because a file it is using is being
+replaced.
+ at item :shutdown
+The system is shutting down or restarting.
+ at end table
+ at end table
+ at end deffn
+
@anchor{event-timer}
@deffn GenericFunction event-timer dispatcher timer
Implement this method to respond to expiration of the current
Modified: trunk/etc/lisp.exe.manifest
==============================================================================
--- trunk/etc/lisp.exe.manifest (original)
+++ trunk/etc/lisp.exe.manifest Thu Jul 13 20:20:12 2006
@@ -1,10 +1,10 @@
-<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
+<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
- <assemblyIdentity version="1.0.0.0" processorArchitecture="X86" name="clisp" type="win32"/>
+ <assemblyIdentity processorArchitecture="x86" name="clisp" type="win32"/>
<description>GNU CLISP</description>
<dependency>
<dependentAssembly>
- <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" processorArchitecture="X86" publicKeyToken="6595b64144ccf1df" language="*"/>
+ <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" processorArchitecture="x86" publicKeyToken="6595b64144ccf1df" language="*"/>
</dependentAssembly>
</dependency>
</assembly>
Modified: trunk/src/packages.lisp
==============================================================================
--- trunk/src/packages.lisp (original)
+++ trunk/src/packages.lisp Thu Jul 13 20:20:12 2006
@@ -395,7 +395,7 @@
#:event-pre-resize
#:event-resize
#:event-select
- #:event-show
+ #:event-session
#:event-timer
#:expand
#:expanded-p
Modified: trunk/src/uitoolkit/system/system-constants.lisp
==============================================================================
--- trunk/src/uitoolkit/system/system-constants.lisp (original)
+++ trunk/src/uitoolkit/system/system-constants.lisp Thu Jul 13 20:20:12 2006
@@ -974,6 +974,24 @@
(defconstant +wm-gettextlength+ #x000E)
(defconstant +wm-paint+ #x000F)
(defconstant +wm-close+ #x0010)
+(defconstant +wm-queryendsession+ #x0011)
+(defconstant +wm-queryopen+ #x0013)
+(defconstant +wm-endsession+ #x0016)
+(defconstant +wm-quit+ #x0012)
+(defconstant +wm-erasebkgnd+ #x0014)
+(defconstant +wm-syscolorchange+ #x0015)
+(defconstant +wm-showwindow+ #x0018)
+(defconstant +wm-wininichange+ #x001A)
+(defconstant +wm-settingchange+ #x001A)
+(defconstant +wm-devmodechange+ #x001B)
+(defconstant +wm-activateapp+ #x001C)
+(defconstant +wm-fontchange+ #x001D)
+(defconstant +wm-timechange+ #x001E)
+(defconstant +wm-cancelmode+ #x001F)
+(defconstant +wm-setcursor+ #x0020)
+(defconstant +wm-mouseactivate+ #x0021)
+(defconstant +wm-childactivate+ #x0022)
+(defconstant +wm-queuesync+ #x0023)
(defconstant +wm-getminmaxinfo+ #x0024)
(defconstant +wm-painticon+ #x0026)
(defconstant +wm-iconerasebkgnd+ #x0027)
Modified: trunk/src/uitoolkit/widgets/event-generics.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/event-generics.lisp (original)
+++ trunk/src/uitoolkit/widgets/event-generics.lisp Thu Jul 13 20:20:12 2006
@@ -178,10 +178,10 @@
(:method (dispatcher item)
(declare (ignorable dispatcher item))))
-(defgeneric event-show (dispatcher widget)
- (:documentation "Implement this to respond to an object being shown.")
- (:method (dispatcher widget)
- (declare (ignorable dispatcher widget))))
+(defgeneric event-session (dispatcher window phase reason)
+ (:documentation "Implement this to participate in the session shutdown protocol.")
+ (:method (dispatcher window phase reason)
+ (declare (ignorable dispatcher window phase reason))))
(defgeneric event-timer (dispatcher timer)
(:documentation "Implement this to respond to a tick from a specific timer.")
Modified: trunk/src/uitoolkit/widgets/event.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/event.lisp (original)
+++ trunk/src/uitoolkit/widgets/event.lisp Thu Jul 13 20:20:12 2006
@@ -142,6 +142,18 @@
(defun obtain-event-time ()
(event-time (thread-context)))
+(defun option->reason (lparam)
+ ;; MSDN says the value is a bitmask, so must be tested bit-wise.
+ (cond
+ ((zerop lparam)
+ :shutdown)
+ ((oddp lparam)
+ :replacing-file)
+ ((= (logand lparam #x80000000) #x80000000)
+ :logoff)
+ (t
+ :shutdown)))
+
;;;
;;; process-message methods
;;;
@@ -214,6 +226,19 @@
(delete-widget (thread-context) hwnd)
0)
+(defmethod process-message (hwnd (msg (eql gfs::+wm-queryendsession+)) wparam lparam)
+ (declare (ignore wparam))
+ (let ((widget (get-widget (thread-context) hwnd)))
+ (unless (null widget)
+ (if (event-session (dispatcher widget) widget :query (option->reason lparam)) 1 0))))
+
+(defmethod process-message (hwnd (msg (eql gfs::+wm-endsession+)) wparam lparam)
+ (declare (ignore wparam))
+ (let ((widget (get-widget (thread-context) hwnd)))
+ (unless (null widget)
+ (event-session (dispatcher widget) widget :end (option->reason lparam))))
+ 0)
+
(defmethod process-message (hwnd (msg (eql gfs::+wm-char+)) wparam lparam)
(declare (ignore lparam))
(let* ((tc (thread-context))
More information about the Graphic-forms-cvs
mailing list