Tue, 06 May 2014 15:59:09 +0200
Backport warning fixes for tcl from deafult
| 6694 | 1 | /* |
| 2 | * Tcl/Glib glue | |
| 3 | * | |
| 13818 | 4 | * Copyright (C) 2003, 2004, 2006 Ethan Blanton <eblanton@cs.purdue.edu> |
| 9516 | 5 | * |
| 6 | * This file is dual-licensed under the two sets of terms below. You may | |
| 7 | * use, redistribute, or modify it pursuant to either the set of conditions | |
| 8 | * under "TERMS 1" or "TERMS 2", at your discretion. The DISCLAIMER | |
| 9 | * applies to both sets of terms. | |
| 10 | * | |
| 11 | * TERMS 1 | |
| 12 | * | |
| 6694 | 13 | * This program is free software; you can redistribute it and/or modify |
| 14 | * it under the terms of the GNU General Public License as published by | |
| 15 | * the Free Software Foundation; either version 2 of the License, or | |
| 16 | * (at your option) any later version. | |
| 17 | * | |
| 9516 | 18 | * You should have received a copy of the GNU General Public License |
| 19 | * along with this program; if not, write to the Free Software | |
|
19859
71d37b57eff2
The FSF changed its address a while ago; our files were out of date.
John Bailey <rekkanoryo@rekkanoryo.org>
parents:
15884
diff
changeset
|
20 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02111-1301 USA |
| 9516 | 21 | * |
| 22 | * TERMS 2 | |
| 23 | * | |
| 24 | * Redistribution and use in source and binary forms, with or without | |
| 25 | * modification, are permitted provided that the following conditions | |
| 26 | * are met: | |
| 27 | * | |
| 28 | * 1. Redistributions of source code must contain the above copyright | |
| 29 | * notice and this comment block in their entirety. | |
| 30 | * | |
| 31 | * 2. Redistributions in binary form must reproduce the above copyright | |
| 32 | * notice and the text of this comment block in their entirety in | |
| 33 | * the documentation and/or other materials provided with the | |
| 34 | * distribution. | |
| 35 | * | |
| 36 | * DISCLAIMER | |
| 37 | * | |
| 6694 | 38 | * This program is distributed in the hope that it will be useful, |
| 39 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 40 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 41 | * GNU General Public License for more details. | |
| 9516 | 42 | */ |
| 43 | ||
| 44 | /* | |
| 6694 | 45 | * NOTES |
|
31294
73607ab89c6f
Remove trailing whitespace
Richard Laager <rlaager@pidgin.im>
parents:
19859
diff
changeset
|
46 | * |
| 15884 | 47 | * This file was developed for the Purple project. It inserts the Tcl |
| 6694 | 48 | * event loop into the glib2 event loop for the purposes of providing |
| 49 | * Tcl bindings in a glib2 (e.g. Gtk2) program. To use it, simply | |
| 50 | * link it into your executable, include tcl_glib.h, and call the | |
| 51 | * function tcl_glib_init() before creating or using any Tcl | |
| 52 | * interpreters. Then go ahead and use Tcl, Tk, whatever to your | |
| 53 | * heart's content. | |
|
31294
73607ab89c6f
Remove trailing whitespace
Richard Laager <rlaager@pidgin.im>
parents:
19859
diff
changeset
|
54 | * |
| 6694 | 55 | * BUGS |
|
31294
73607ab89c6f
Remove trailing whitespace
Richard Laager <rlaager@pidgin.im>
parents:
19859
diff
changeset
|
56 | * |
| 6694 | 57 | * tcl_wait_for_event seems to have a bug that makes vwait not work so |
| 58 | * well... I'm not sure why, yet, but I haven't put much time into | |
| 59 | * it. Hopefully I will figure it out soon. In the meantime, this | |
| 60 | * means that Tk's bgerror function (which is called when there is an | |
| 61 | * error in a callback function) causes some Bad Mojo -- you should | |
| 62 | * override it with a function that does not use Tk | |
| 63 | */ | |
| 64 | ||
| 65 | #include <tcl.h> | |
| 66 | #include <glib.h> | |
| 67 | #include <string.h> | |
| 68 | ||
| 69 | #include "tcl_glib.h" | |
| 70 | ||
|
35987
65200382abb9
Backport warning fixes for tcl from deafult
Tomasz Wasilczyk <twasilczyk@pidgin.im>
parents:
31294
diff
changeset
|
71 | #ifndef CONST86 |
|
65200382abb9
Backport warning fixes for tcl from deafult
Tomasz Wasilczyk <twasilczyk@pidgin.im>
parents:
31294
diff
changeset
|
72 | # define CONST86 |
|
65200382abb9
Backport warning fixes for tcl from deafult
Tomasz Wasilczyk <twasilczyk@pidgin.im>
parents:
31294
diff
changeset
|
73 | #endif |
|
65200382abb9
Backport warning fixes for tcl from deafult
Tomasz Wasilczyk <twasilczyk@pidgin.im>
parents:
31294
diff
changeset
|
74 | |
| 6694 | 75 | struct tcl_file_handler { |
| 76 | int source; | |
| 77 | int fd; | |
| 78 | int mask; | |
| 79 | int pending; | |
| 80 | Tcl_FileProc *proc; | |
| 81 | ClientData data; | |
| 82 | }; | |
| 83 | ||
| 84 | struct tcl_file_event { | |
| 85 | Tcl_Event header; | |
| 86 | int fd; | |
| 87 | }; | |
| 88 | ||
| 89 | static guint tcl_timer; | |
| 90 | static gboolean tcl_timer_pending; | |
| 91 | static GHashTable *tcl_file_handlers; | |
| 92 | ||
|
35987
65200382abb9
Backport warning fixes for tcl from deafult
Tomasz Wasilczyk <twasilczyk@pidgin.im>
parents:
31294
diff
changeset
|
93 | static void tcl_set_timer(CONST86 Tcl_Time *timePtr); |
|
65200382abb9
Backport warning fixes for tcl from deafult
Tomasz Wasilczyk <twasilczyk@pidgin.im>
parents:
31294
diff
changeset
|
94 | static int tcl_wait_for_event(CONST86 Tcl_Time *timePtr); |
| 6694 | 95 | static void tcl_create_file_handler(int fd, int mask, Tcl_FileProc *proc, ClientData data); |
| 96 | static void tcl_delete_file_handler(int fd); | |
| 97 | ||
| 98 | static gboolean tcl_kick(gpointer data); | |
| 99 | static gboolean tcl_file_callback(GIOChannel *source, GIOCondition condition, gpointer data); | |
| 100 | static int tcl_file_event_callback(Tcl_Event *event, int flags); | |
| 101 | ||
|
7831
54076c9af6ad
[gaim-migrate @ 8483]
Herman Bloggs <herman@bluedigits.com>
parents:
7822
diff
changeset
|
102 | #undef Tcl_InitNotifier |
|
54076c9af6ad
[gaim-migrate @ 8483]
Herman Bloggs <herman@bluedigits.com>
parents:
7822
diff
changeset
|
103 | |
| 6694 | 104 | ClientData Tcl_InitNotifier() |
| 105 | { | |
| 106 | return NULL; | |
| 107 | } | |
| 108 | ||
| 109 | void tcl_glib_init () | |
| 110 | { | |
| 111 | Tcl_NotifierProcs notifier; | |
| 112 | ||
| 7822 | 113 | memset(¬ifier, 0, sizeof(notifier)); |
| 114 | ||
| 6694 | 115 | notifier.createFileHandlerProc = tcl_create_file_handler; |
| 116 | notifier.deleteFileHandlerProc = tcl_delete_file_handler; | |
| 117 | notifier.setTimerProc = tcl_set_timer; | |
| 118 | notifier.waitForEventProc = tcl_wait_for_event; | |
| 119 | ||
| 120 | Tcl_SetNotifier(¬ifier); | |
| 8116 | 121 | Tcl_SetServiceMode(TCL_SERVICE_ALL); |
| 6694 | 122 | |
| 123 | tcl_timer_pending = FALSE; | |
| 124 | tcl_file_handlers = g_hash_table_new(g_direct_hash, g_direct_equal); | |
| 125 | } | |
| 126 | ||
| 127 | static void tcl_set_timer(Tcl_Time *timePtr) | |
| 128 | { | |
| 129 | guint interval; | |
| 130 | ||
| 131 | if (tcl_timer_pending) | |
| 132 | g_source_remove(tcl_timer); | |
| 133 | ||
| 134 | if (timePtr == NULL) { | |
| 135 | tcl_timer_pending = FALSE; | |
| 136 | return; | |
| 137 | } | |
| 138 | ||
| 139 | interval = timePtr->sec * 1000 + (timePtr->usec ? timePtr->usec / 1000 : 0); | |
| 140 | tcl_timer = g_timeout_add(interval, tcl_kick, NULL); | |
| 141 | tcl_timer_pending = TRUE; | |
| 142 | } | |
| 143 | ||
| 144 | static int tcl_wait_for_event(Tcl_Time *timePtr) | |
| 145 | { | |
| 146 | if (!timePtr || (timePtr->sec == 0 && timePtr->usec == 0)) { | |
| 147 | g_main_context_iteration(NULL, FALSE); | |
| 148 | return 1; | |
| 149 | } else { | |
| 150 | tcl_set_timer(timePtr); | |
| 151 | } | |
| 152 | ||
| 153 | g_main_context_iteration(NULL, TRUE); | |
| 154 | ||
| 155 | return 1; | |
| 156 | } | |
| 157 | ||
| 158 | static void tcl_create_file_handler(int fd, int mask, Tcl_FileProc *proc, ClientData data) | |
| 159 | { | |
| 160 | struct tcl_file_handler *tfh = g_new0(struct tcl_file_handler, 1); | |
| 161 | GIOChannel *channel; | |
| 162 | GIOCondition cond = 0; | |
| 163 | ||
| 13818 | 164 | if (g_hash_table_lookup(tcl_file_handlers, GINT_TO_POINTER(fd))) |
| 165 | tcl_delete_file_handler(fd); | |
|
31294
73607ab89c6f
Remove trailing whitespace
Richard Laager <rlaager@pidgin.im>
parents:
19859
diff
changeset
|
166 | |
| 6694 | 167 | if (mask & TCL_READABLE) |
| 168 | cond |= G_IO_IN; | |
| 169 | if (mask & TCL_WRITABLE) | |
| 170 | cond |= G_IO_OUT; | |
| 171 | if (mask & TCL_EXCEPTION) | |
| 172 | cond |= G_IO_ERR|G_IO_HUP|G_IO_NVAL; | |
| 173 | ||
| 174 | tfh->fd = fd; | |
| 175 | tfh->mask = mask; | |
| 176 | tfh->proc = proc; | |
| 177 | tfh->data = data; | |
| 178 | ||
| 179 | channel = g_io_channel_unix_new(fd); | |
| 180 | tfh->source = g_io_add_watch_full(channel, G_PRIORITY_DEFAULT, cond, tcl_file_callback, tfh, g_free); | |
| 181 | g_io_channel_unref(channel); | |
| 182 | ||
| 13818 | 183 | g_hash_table_insert(tcl_file_handlers, GINT_TO_POINTER(fd), tfh); |
| 6694 | 184 | |
| 185 | Tcl_ServiceAll(); | |
| 186 | } | |
| 187 | ||
| 188 | static void tcl_delete_file_handler(int fd) | |
| 189 | { | |
| 14007 | 190 | struct tcl_file_handler *tfh = g_hash_table_lookup(tcl_file_handlers, GINT_TO_POINTER(fd)); |
| 6694 | 191 | |
| 192 | if (tfh == NULL) | |
| 193 | return; | |
| 194 | ||
| 195 | g_source_remove(tfh->source); | |
| 13818 | 196 | g_hash_table_remove(tcl_file_handlers, GINT_TO_POINTER(fd)); |
| 6694 | 197 | |
| 198 | Tcl_ServiceAll(); | |
| 199 | } | |
| 200 | ||
| 201 | static gboolean tcl_kick(gpointer data) | |
| 202 | { | |
| 203 | tcl_timer_pending = FALSE; | |
| 204 | ||
| 205 | Tcl_ServiceAll(); | |
| 206 | ||
| 207 | return FALSE; | |
| 208 | } | |
| 209 | ||
| 210 | static gboolean tcl_file_callback(GIOChannel *source, GIOCondition condition, gpointer data) | |
| 211 | { | |
| 212 | struct tcl_file_handler *tfh = data; | |
| 213 | struct tcl_file_event *fev; | |
| 214 | int mask = 0; | |
| 215 | ||
| 216 | if (condition & G_IO_IN) | |
| 217 | mask |= TCL_READABLE; | |
| 218 | if (condition & G_IO_OUT) | |
| 219 | mask |= TCL_WRITABLE; | |
| 220 | if (condition & (G_IO_ERR|G_IO_HUP|G_IO_NVAL)) | |
| 221 | mask |= TCL_EXCEPTION; | |
| 222 | ||
| 223 | if (!(tfh->mask & (mask & ~tfh->pending))) | |
| 224 | return TRUE; | |
| 225 | ||
| 226 | tfh->pending |= mask; | |
| 227 | fev = (struct tcl_file_event *)ckalloc(sizeof(struct tcl_file_event)); | |
| 228 | memset(fev, 0, sizeof(struct tcl_file_event)); | |
| 229 | fev->header.proc = tcl_file_event_callback; | |
| 230 | fev->fd = tfh->fd; | |
| 231 | Tcl_QueueEvent((Tcl_Event *)fev, TCL_QUEUE_TAIL); | |
| 232 | ||
| 233 | Tcl_ServiceAll(); | |
| 234 | ||
| 235 | return TRUE; | |
| 236 | } | |
| 237 | ||
| 238 | int tcl_file_event_callback(Tcl_Event *event, int flags) | |
| 239 | { | |
| 240 | struct tcl_file_handler *tfh; | |
| 241 | struct tcl_file_event *fev = (struct tcl_file_event *)event; | |
| 242 | int mask; | |
| 243 | ||
| 244 | if (!(flags & TCL_FILE_EVENTS)) { | |
| 245 | return 0; | |
| 246 | } | |
| 247 | ||
| 13818 | 248 | tfh = g_hash_table_lookup(tcl_file_handlers, GINT_TO_POINTER(fev->fd)); |
| 6694 | 249 | if (tfh == NULL) |
| 250 | return 1; | |
| 251 | ||
| 252 | mask = tfh->mask & tfh->pending; | |
| 253 | if (mask) | |
| 254 | (*tfh->proc)(tfh->data, mask); | |
| 255 | tfh->pending = 0; | |
| 256 | ||
| 257 | return 1; | |
| 258 | } |