tcl-extensions

Check-in [feb760fc97]
Login

Check-in [feb760fc97]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:fix silly errors: now compiles
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | winlock
Files: files | file ages | folders
SHA1: feb760fc97dd11f5d699d10bbc5a2079b6b5ac81
User & Date: aspect 2015-12-15 01:53:06.248
Context
2015-12-15
02:34
fix name of init function Leaf check-in: 419ca30322 user: aspect tags: winlock
01:53
fix silly errors: now compiles check-in: feb760fc97 user: aspect tags: winlock
01:03
move windows source to windows platform .. what if there is nothing to build on unix? check-in: 983cf52a87 user: aspect tags: winlock
Changes
Side-by-Side Diff Ignore Whitespace Patch
Changes to win/tclwinlock.c.
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
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










-
+



-
+






-
+




-
+





-
+









-
+

-
+




-
+


-
+



















-
-
+
+







-
+











-
+
+
+
+







#include <tcl.h>
#include <windows.h>

int Tcl_WinLockObjCmd(
        ClientData cdata,
        Tcl_Interp *interp,
        int objc,
        Tcl_Obj *const objv[])
{
    Tcl_Channel channel;
    ClientData  *hread, *hwrite;
    ClientData  hread, hwrite;

    DWORD                       flags;
    DWORD                       nb_low, nb_high;
    LPOVERLAPPED                ovl;
    OVERLAPPED                  ovl;
    BY_HANDLE_FILE_INFORMATION  fileinfo;

    int f_exclusive = 0;

    /*  ?-exclusive? */
    if(objc < 2) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Not enough arguments!  Expected \"%s ?-exclusive? chan\"", objv[0]));
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Not enough arguments!  Expected \"%s ?-exclusive? chan\"", Tcl_GetString(objv[0])));
        Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
        return TCL_ERROR;
    }
    if(objc > 3) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Too many arguments!  Expected \"%s ?-exclusive? chan\"", objv[0]));
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Too many arguments!  Expected \"%s ?-exclusive? chan\"", Tcl_GetString(objv[0])));
        Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
        return TCL_ERROR;
    }
    if(objc == 3) {
        const char* name = Tcl_GetString(objv[1]);
        if(strcmp(name, "-exclusive", strlen(name)) == 0) {
        if(strncmp(name, "-exclusive", strlen(name)) == 0) {
            f_exclusive = 1;
        } else {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf("Invalid option \"%s\"! Expected ?-exclusive?", name));
            Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
            return TCL_ERROR;
        }
    }

    /* obtain channel from last argument */
    channel = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[objc-1], NULL), NULL);
    channel = Tcl_GetChannel(interp, Tcl_GetString(objv[objc-1]), NULL);
    if(channel == (Tcl_Channel) NULL) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Not a channel: \"%s\"!", Tcl_GetStringFromObj(objv[objc-1])));
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Not a channel: \"%s\"!", Tcl_GetString(objv[objc-1])));
        return TCL_ERROR;
    }

    /* get the underlying file handles */
    if(TCL_ERR == Tcl_GetChannelHandle(channel, TCL_READABLE, &hread)) {
    if(TCL_ERROR == Tcl_GetChannelHandle(channel, TCL_READABLE, &hread)) {
        hread = NULL;
    }
    if(TCL_ERR == Tcl_GetChannelHandle(channel, TCL_WRITABLE, &hwrite)) {
    if(TCL_ERROR == Tcl_GetChannelHandle(channel, TCL_WRITABLE, &hwrite)) {
        hwrite = NULL;
    }
    if(hread == NULL) { hread = hwrite; }
    if(hwrite == hread) { hwrite = NULL; }
    if(hwrite != NULL) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Two handles!  Unable to lock (%p, %p)", hread, hwrite));
        return TCL_ERROR;
    }

    /* populate the lock region */
    if(GetFileInformationByHandle(hread, &fileinfo) != TRUE) {
        Tcl_SetResult(interp, "unable to get file information: ", TCL_STATIC);
        goto getLastError;
    } else {
        nb_high = fileinfo.nFileSizeHigh;
        nb_low  = fileinfo.nFileSizeLow;
    }

    /* prepare for LockFileEx() */
    memset(ovl, 0, sizeof(ovl));
    ovl->hEvent = 0;
    memset(&ovl, 0, sizeof(ovl));
    ovl.hEvent = 0;

    flags = LOCKFILE_FAIL_IMMEDIATELY;
    if(f_exclusive) {
        flags |= LOCKFILE_EXCLUSIVE_LOCK;
    }

    /* call LockFileEx */
    if(LockFileEx(hread, flags, 0, nb_low, nb_high, ovl)) {
    if(LockFileEx(hread, flags, 0, nb_low, nb_high, &ovl)) {

        Tcl_SetObjResult(interp, Tcl_ObjPrintf("Locked %p", hread));
        /* we don't care about the overlay structure; it would be needed for unlocking if we did */
        return TCL_OK;
    }

getLastError:
    {
        /* handle Windows error - cribbed from AppendSystemError in tclWinReg.c */
        DWORD error;
        TCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr;
	char *msgPtr;
        char *msgPtr;
        char id[16];
        char msgBuf[1024];
        char *msg;
        Tcl_DString ds;
        DWORD length;

        error = GetLastError();
        length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER,
                             NULL, error,
                             MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (TCHAR *) tMsgPtrPtr,