~ubuntu-branches/ubuntu/natty/perl-tk/natty

« back to all changes in this revision

Viewing changes to Event/Event.xs

  • Committer: Bazaar Package Importer
  • Author(s): Stephen Zander
  • Date: 2004-03-14 13:54:44 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20040314135444-prc09u2or4dbr3to
Tags: 1:800.025-2
Add xlibs-dev to Build-Depends:,
Closes: #237942

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
1
/*
2
 
  Copyright (c) 1995-1999 Nick Ing-Simmons. All rights reserved.
 
2
  Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
3
3
  This program is free software; you can redistribute it and/or
4
4
  modify it under the same terms as Perl itself.
5
5
*/
15
15
#include "pTk/tkEvent.h"
16
16
#include "pTk/tkEvent_f.h"
17
17
 
 
18
#ifndef INT2PTR
 
19
#define INT2PTR(any,d) (any)(d)
 
20
#endif
 
21
#ifndef PTR2IV
 
22
#define PTR2IV(p)       INT2PTR(IV,p)
 
23
#endif
 
24
 
18
25
void
19
26
LangDebug(char *fmt,...)
20
27
{
219
226
Lang_OSHandle(fd)
220
227
int fd;
221
228
{
222
 
#ifdef WIN32
 
229
#if defined(WIN32) && !defined(__CYGWIN__)
223
230
 return win32_get_osfhandle(fd);
224
231
#else
225
232
 return fd;
252
259
   typedef int (*fptr)_((void));
253
260
   fptr *q = table;
254
261
   unsigned i;
255
 
   sv_setiv(FindVarName(name,GV_ADD|GV_ADDMULTI),(IV) table);
 
262
   sv_setiv(FindVarName(name,GV_ADD|GV_ADDMULTI),PTR2IV(table));
256
263
   if (size % sizeof(fptr))
257
264
    {
258
265
     warn("%s is strange size %d",name,size);
295
302
  int handlerMask;                /* Events for which we have callbacks */
296
303
  int callingMask;                /* Events for which we are in callbacks */
297
304
  int pending;
298
 
 } PerlIOHandler;
 
305
  SV *mysv;
 
306
  } PerlIOHandler;
299
307
 
300
308
typedef struct PerlIOEvent
301
309
 {
600
608
         SV *sv = filePtr->readHandler;
601
609
         ENTER;
602
610
         SAVETMPS;
 
611
         SvREFCNT_inc(filePtr->mysv);
603
612
         filePtr->callingMask |= TCL_READABLE;
604
613
         LangPushCallbackArgs(&sv);
605
614
         LangCallCallback(sv,G_DISCARD);
606
615
         filePtr->callingMask &= ~TCL_READABLE;
 
616
         SvREFCNT_dec(filePtr->mysv);
607
617
         FREETMPS;
608
618
         LEAVE;
609
619
        }
612
622
         SV *sv = filePtr->writeHandler;
613
623
         ENTER;
614
624
         SAVETMPS;
 
625
         SvREFCNT_inc(filePtr->mysv);
615
626
         filePtr->callingMask |= TCL_WRITABLE;
616
627
         LangPushCallbackArgs(&sv);
617
628
         LangCallCallback(sv,G_DISCARD);
618
629
         filePtr->callingMask &= ~TCL_WRITABLE;
 
630
         SvREFCNT_dec(filePtr->mysv);
619
631
         FREETMPS;
620
632
         LEAVE;
621
633
        }
624
636
         SV *sv = filePtr->exceptionHandler;
625
637
         ENTER;
626
638
         SAVETMPS;
 
639
         SvREFCNT_inc(filePtr->mysv);
627
640
         filePtr->callingMask |= TCL_EXCEPTION;
628
641
         LangPushCallbackArgs(&sv);
629
642
         LangCallCallback(sv,G_DISCARD);
630
643
         filePtr->callingMask &= ~TCL_EXCEPTION;
 
644
         SvREFCNT_dec(filePtr->mysv);
631
645
         FREETMPS;
632
646
         LEAVE;
633
647
        }
716
730
 filePtr->waitMask    = mask;
717
731
 filePtr->pending     = 0;
718
732
 filePtr->nextPtr     = firstPerlIOHandler;
 
733
 filePtr->mysv        = obj;
719
734
 firstPerlIOHandler   = filePtr;
720
735
 PerlIO_watch(filePtr);
721
736
 obj = newRV_noinc(obj);