--
Yusuke Shinyama
Dept. of Computer Science, Tokyo Inst. of Technology,
E-MAIL: euske_at_cl.cs.titech.ac.jp
-----------------------------------------------------
diff -rc STk-4.0.1.orig/Extensions/socket.c STk-4.0.1/Extensions/socket.c
*** STk-4.0.1.orig/Extensions/socket.c Sat Sep 4 05:21:32 1999
--- STk-4.0.1/Extensions/socket.c Fri Dec 10 18:53:59 1999
***************
*** 329,349 ****
* w h e n - s o c k e t - r e a d y
*
******************************************************************************/
#ifdef WIN32
static PRIMITIVE when_socket_ready(SCM s, SCM closure)
{
! /* Removal of tcl_DeleteFileHandler and tclDeleteFileHandler */
/* in Tcl/Tk 8.0 make when_socket_ready impossible on Win32. */
/* Will be available again in Tcl/Tk version 8.1 FIXME */
Err("when-socket-ready: cannot be used with Win32", NIL);
return UNDEFINED;
}
#else
! static void apply_socket_closure(SCM closure)
! {
! Apply0(closure);
! }
!
static PRIMITIVE when_socket_ready(SCM s, SCM closure)
{
int fd;
--- 329,426 ----
* w h e n - s o c k e t - r e a d y
*
******************************************************************************/
+ static void apply_socket_closure(SCM closure)
+ {
+ Apply0(closure);
+ }
+
#ifdef WIN32
+ /* WSAAsyncSelect allows asynchronous socket operation
+ but we need a certain window to send the socket event STK_WM_SOCKET.
+ This program uses a dummy window used in tclWinNotify.c */
+
+ /* This structure must be the same as that of tclWinNotify.c! */
+ typedef struct {
+ HWND hwnd; /* Messaging window. */
+ int timeout; /* Current timeout value. */
+ int timerActive; /* 1 if interval timer is running. */
+ } notifier_t;
+ extern notifier_t notifier;
+
+ /* socket handling closures */
+ static SCM winsock_accept_handler;
+ static SCM winsock_read_handler;
+
+ /* When the dummy window receives STK_WM_SOCKET, the event handler
+ related to the window calls this procedure with the type of the socket event */
+ void STk_handle_winsock_event(long ev)
+ {
+ switch(ev) {
+ case FD_ACCEPT:
+ if (winsock_accept_handler != Ntruth)
+ apply_socket_closure(winsock_accept_handler);
+ break;
+ case FD_READ:
+ if (winsock_read_handler != Ntruth)
+ apply_socket_closure(winsock_read_handler);
+ break;
+ }
+ }
+
+ /* Set a socket handler for accepting.
+ Caution: It's impossible to bind two or more sockets at the same time! */
+ static PRIMITIVE when_socket_acceptable(SCM fd, SCM closure)
+ {
+ if (NINTEGERP(fd))
+ Err("when-socket-acceptable: bad fd", fd);
+ if (closure == UNBOUND)
+ return(winsock_accept_handler);
+ if (closure == Ntruth) {
+ winsock_accept_handler = Ntruth;
+ return UNDEFINED;
+ }
+ if (winsock_accept_handler != Ntruth)
+ Err("when-socket-acceptable: accept handle already set", winsock_accept_handler);
+ if (STk_procedurep(closure) == Ntruth)
+ Err("when-socket-acceptable: bad closure", closure);
+ winsock_accept_handler = closure;
+ if (WSAAsyncSelect(INTEGER(fd), notifier.hwnd, STK_WM_SOCKET, FD_ACCEPT))
+ Err("when-socket-acceptable: cannot set nonblocking", fd);
+ return UNDEFINED;
+ }
+
+ /* Set a socket handler for receiving.
+ Caution: It's impossible to bind two or more sockets at the same time! */
+ static PRIMITIVE when_socket_readable(SCM fd, SCM closure)
+ {
+ if (NINTEGERP(fd))
+ Err("when-socket-readable: bad fd", fd);
+ if (closure == UNBOUND)
+ return(winsock_read_handler);
+ if (closure == Ntruth) {
+ winsock_read_handler = Ntruth;
+ return UNDEFINED;
+ }
+ if (winsock_read_handler != Ntruth)
+ Err("when-socket-readable: accept handle already set", winsock_read_handler);
+ if (STk_procedurep(closure) == Ntruth)
+ Err("when-socket-readable: bad closure", closure);
+ winsock_read_handler = closure;
+ if (WSAAsyncSelect(INTEGER(fd), notifier.hwnd, STK_WM_SOCKET, FD_READ))
+ Err("when-socket-readable: cannot set nonblocking", fd);
+ return UNDEFINED;
+ }
+
static PRIMITIVE when_socket_ready(SCM s, SCM closure)
{
! /* Removal of tcl_DeleteFileHandler and tclDeleteFileHandler */
/* in Tcl/Tk 8.0 make when_socket_ready impossible on Win32. */
/* Will be available again in Tcl/Tk version 8.1 FIXME */
Err("when-socket-ready: cannot be used with Win32", NIL);
return UNDEFINED;
}
#else
! /* for UNIX */
static PRIMITIVE when_socket_ready(SCM s, SCM closure)
{
int fd;
***************
*** 372,378 ****
}
return UNDEFINED;
}
! #endif
static PRIMITIVE buggy_handler(SCM s, SCM closure)
{
--- 449,455 ----
}
return UNDEFINED;
}
! #endif /* WIN32 */
static PRIMITIVE buggy_handler(SCM s, SCM closure)
{
***************
*** 659,664 ****
--- 736,747 ----
STk_add_new_primitive("socket-send", tc_subr_3, socket_send);
STk_add_new_primitive("initialize-client-socket", tc_subr_2,
initialize_client_socket);
+ STk_add_new_primitive("when-socket-acceptable", tc_subr_1_or_2, when_socket_acceptable);
+ STk_add_new_primitive("when-socket-readable", tc_subr_1_or_2, when_socket_readable);
+ STk_gc_protect(&winsock_accept_handler);
+ STk_gc_protect(&winsock_read_handler);
+ winsock_accept_handler = Ntruth;
+ winsock_read_handler = Ntruth;
#endif
tc_socket = STk_add_new_type(&socket_type);
diff -rc STk-4.0.1.orig/Lib/winsocket.stklos STk-4.0.1/Lib/winsocket.stklos
*** STk-4.0.1.orig/Lib/winsocket.stklos Tue Aug 24 05:16:59 1999
--- STk-4.0.1/Lib/winsocket.stklos Fri Dec 10 18:50:23 1999
***************
*** 27,32 ****
--- 27,36 ----
(unless (symbol-bound? '<socket-port>)
(require "stklos")
+ (define-generic when-socket-acceptable)
+ (define-generic when-socket-readable)
+ (define-generic when-socket-closeable)
+
;;;;***********************************************************************
;;;;
;;;; socket-port class definitions (adds port i/o facilities)
***************
*** 116,121 ****
--- 120,137 ----
(next-method)
))
+ ;;;;
+ ;;;; when-socket-readable (for client socket)
+ ;;;;
+ (define-method when-socket-readable ((self <client-socket>) closure)
+ (when-socket-readable (handle-of self) closure))
+
+ ;;;;
+ ;;;; when-socket-closeable (for client socket)
+ ;;;;
+ (define-method when-socket-closeable ((self <client-socket>) closure)
+ (when-socket-closeable (handle-of self) closure))
+
;;;;***********************************************************************
;;;;
;;;; server-socket class definition
***************
*** 139,144 ****
--- 155,178 ----
))
;;;;
+ ;;;; when-socket-acceptable (for server socket only)
+ ;;;;
+ (define-method when-socket-acceptable ((self <server-socket>) closure)
+ (when-socket-acceptable (socket-handle (socket-of self)) closure))
+
+ ;;;;
+ ;;;; when-socket-readable (for server socket)
+ ;;;;
+ (define-method when-socket-readable ((self <server-socket>) closure)
+ (when-socket-readable (slot-ref self 'connection) closure))
+
+ ;;;;
+ ;;;; when-socket-closeable (for server socket)
+ ;;;;
+ (define-method when-socket-closeable ((self <server-socket>) closure)
+ (when-socket-closeable (slot-ref self 'connection) closure))
+
+ ;;;;
;;;; accept-server-connection (accept server connection)
;;;;
(define-method accept-server-connection ((self <server-socket>))
***************
*** 406,408 ****
--- 440,445 ----
(close-socket-port self))
)
+
+ ;
+ (provide "winsocket")
diff -rc STk-4.0.1.orig/Tcl/tcl.h STk-4.0.1/Tcl/tcl.h
*** STk-4.0.1.orig/Tcl/tcl.h Tue Aug 31 21:05:21 1999
--- STk-4.0.1/Tcl/tcl.h Fri Dec 10 18:47:27 1999
***************
*** 1622,1625 ****
--- 1622,1632 ----
# endif
#endif
+ /* for winsock added by euske 99/11 */
+ #ifdef STk_CODE
+ # ifdef WIN32
+ # define STK_WM_SOCKET (WM_USER+4)
+ # endif
+ #endif
+
#endif /* _TCL */
diff -rc STk-4.0.1.orig/Tcl/tclWinNotify.c STk-4.0.1/Tcl/tclWinNotify.c
*** STk-4.0.1.orig/Tcl/tclWinNotify.c Fri Jan 22 22:44:12 1999
--- STk-4.0.1/Tcl/tclWinNotify.c Fri Dec 10 18:53:07 1999
***************
*** 30,40 ****
* Windows implementation of the Tcl notifier.
*/
! static struct {
HWND hwnd; /* Messaging window. */
int timeout; /* Current timeout value. */
int timerActive; /* 1 if interval timer is running. */
! } notifier;
/*
* Static routines defined in this file.
--- 30,42 ----
* Windows implementation of the Tcl notifier.
*/
! /* "notifier" is used by STk socket.c also, so indicator "static" was removed. */
! typedef struct {
HWND hwnd; /* Messaging window. */
int timeout; /* Current timeout value. */
int timerActive; /* 1 if interval timer is running. */
! } notifier_t;
! notifier_t notifier;
/*
* Static routines defined in this file.
***************
*** 216,224 ****
WPARAM wParam,
LPARAM lParam)
{
!
! if (message != WM_TIMER) {
! return DefWindowProc(hwnd, message, wParam, lParam);
}
/*
--- 218,243 ----
WPARAM wParam,
LPARAM lParam)
{
! #ifdef STk_CODE
! extern void STk_handle_winsock_event(long ev);
! #endif
!
! /* for winsock added by euske 99/10 */
! switch(message) {
! #ifdef STk_CODE
! /* message STK_WM_SOCKET is prepared by WSAAsyncSelect in socket.c */
! case STK_WM_SOCKET:
! if (!WSAGETSELECTERROR(lParam)) {
! /* call scheme procedure */
! STk_handle_winsock_event(WSAGETSELECTEVENT(lParam));
! }
! return(1);
! break;
! #endif
! case WM_TIMER:
! break;
! default:
! return DefWindowProc(hwnd, message, wParam, lParam);
}
/*
--------------------------------------------------------------
Received on Fri Dec 10 1999 - 13:28:58 CET
This archive was generated by hypermail 2.3.0 : Mon Jul 21 2014 - 19:38:59 CEST