File: chnGlue.c

package info (click to toggle)
perl-tk 1:800.025-2
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 18,444 kB
  • ctags: 19,081
  • sloc: ansic: 206,740; perl: 40,187; makefile: 4,371; sh: 2,373; yacc: 762
file content (112 lines) | stat: -rw-r--r-- 2,137 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
/*
  Copyright (c) 1997-1998 Nick Ing-Simmons. All rights reserved.
  This program is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.
*/

#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>

#include "tkGlue.def"

#include "pTk/tkPort.h"
#include "pTk/tkInt.h"
#include "tkGlue.h"

Tcl_Channel
Tcl_OpenFileChannel(interp,fileName,modeString,permissions)
Tcl_Interp *interp;
char *fileName;
char *modeString;
int permissions;
{PerlIO *f = PerlIO_open(fileName,modeString);
 if (!f)
  {
   /* FIXME - use strerr() or perl's equivalent */
   Tcl_SprintfResult(interp,"Cannot open '%s' in mode '%s'",fileName, modeString);
  }
 return (Tcl_Channel) f;
}

Tcl_Channel
Tcl_GetChannel (Tcl_Interp *interp,char *chanName, int *modePtr)
{
 Tcl_SprintfResult(interp,"Tcl_GetChannel %s not implemeted",chanName);
 return NULL;
}


int
Tcl_Read(chan,bufPtr,toRead)
Tcl_Channel chan;
char *bufPtr;
int toRead;
{
 PerlIO *f = (PerlIO *) chan;
 return PerlIO_read(f,bufPtr,toRead);
}

int
Tcl_Write(chan, buf, count)
Tcl_Channel chan;
char *buf;
int count;
{
 PerlIO *f = (PerlIO *) chan;
 if (count < 0)
  count = strlen(buf);
 return PerlIO_write(f,buf,count);
}

int
Tcl_Close(interp,chan)
Tcl_Interp *interp;
Tcl_Channel chan;
{
 return PerlIO_close((PerlIO *) chan);
}

int
Tcl_Seek(chan, offset, mode)
Tcl_Channel chan;
int offset;
int mode;
{
 PerlIO_seek((PerlIO *) chan, offset, mode);
 return PerlIO_tell((PerlIO *) chan);
}

int
Tcl_Eof(Tcl_Channel chan)
{
 PerlIO *f = (PerlIO *) chan;
 return PerlIO_eof(f);
}

int
Tcl_SetChannelOption(Tcl_Interp *interp, Tcl_Channel chan,
                  char *optionName, char *newValue)
{
 PerlIO *f = (PerlIO *) chan;
 if (LangCmpOpt("-translation",optionName,-1) == 0)
  {
   if (strcmp(newValue,"binary") == 0)
    {
#ifdef USE_PERLIO
     PerlIO_binmode(aTHX_ f, '<', O_BINARY, Nullch);
#else
#if defined(WIN32) || defined(__EMX__)  || defined(__CYGWIN__)
     setmode(PerlIO_fileno(f), O_BINARY);
#endif
#endif
     return TCL_OK;
    }
  }
 warn("Set option %s=%s on channel %d", optionName, newValue, PerlIO_fileno(f));
 return TCL_OK;
}