root/rat/trunk/tcltk.c @ 4213

Revision 4213, 10.6 KB (checked in by turam, 6 years ago)

Accept -X arguments on command line, and pass to underlying apps and into tcl interpreter

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1/*
2 * FILE:    tcltk.c
3 * PROGRAM: RAT
4 * AUTHOR:  Isidor Kouvelas + Colin Perkins + Orion Hodson
5 *
6 * Copyright (c) 1995-2001 University College London
7 * All rights reserved.
8 */
9
10#ifndef HIDE_SOURCE_STRINGS
11static const char cvsid[] =
12        "$Id$";
13#endif /* HIDE_SOURCE_STRINGS */
14
15#include "config_unix.h"
16#include "config_win32.h"
17#include "tcl.h"
18#include "tk.h"
19#include "debug.h"
20#include "auddev.h"
21#include "memory.h"
22#include "version.h"
23#include "mbus.h"
24#include "mbus_parser.h"
25#include "mbus_ui.h"
26#include "tcltk.h"
27#include "util.h"
28
29extern char     ui_audiotool[];
30extern char     ui_transcoder[];
31
32#ifdef WIN32
33int
34WinPutsCmd(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
35{
36    FILE *f;
37    int i, newline;
38    char *fileId;
39
40    i = 1;
41    newline = 1;
42    if ((argc >= 2) && (strcmp(argv[1], "-nonewline") == 0)) {
43        newline = 0;
44        i++;
45    }
46    if ((i < (argc-3)) || (i >= argc)) {
47        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
48                " ?-nonewline? ?fileId? string\"", (char *) NULL);
49        return TCL_ERROR;
50    }
51
52    /*
53     * The code below provides backwards compatibility with an old
54     * form of the command that is no longer recommended or documented.
55     */
56
57    if (i == (argc-3)) {
58        if (strncmp(argv[i+2], "nonewline", strlen(argv[i+2])) != 0) {
59            Tcl_AppendResult(interp, "bad argument \"", argv[i+2],
60                    "\": should be \"nonewline\"", (char *) NULL);
61            return TCL_ERROR;
62        }
63        newline = 0;
64    }
65    if (i == (argc-1)) {
66        fileId = "stdout";
67    } else {
68        fileId = argv[i];
69        i++;
70    }
71
72    if (strcmp(fileId, "stdout") == 0 || strcmp(fileId, "stderr") == 0) {
73        char *result;
74
75        if (newline) {
76            int len = strlen(argv[i]);
77            result = ckalloc(len+2);
78            memcpy(result, argv[i], len);
79            result[len] = '\n';
80            result[len+1] = 0;
81        } else {
82            result = argv[i];
83        }
84        OutputDebugString(result);
85        if (newline)
86            ckfree(result);
87    } else {
88        return TCL_OK;
89        clearerr(f);
90        fputs(argv[i], f);
91        if (newline) {
92            fputc('\n', f);
93        }
94        if (ferror(f)) {
95            Tcl_AppendResult(interp, "error writing \"", fileId,
96                    "\": ", Tcl_PosixError(interp), (char *) NULL);
97            return TCL_ERROR;
98        }
99    }
100    return TCL_OK;
101}
102
103int
104WinGetUserName(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
105{
106    char user[256];
107    int size = sizeof(user);
108
109    if (!GetUserName(user, &size)) {
110        Tcl_AppendResult(interp, "GetUserName failed", NULL);
111        return TCL_ERROR;
112    }
113    purge_chars(user, " \"`'![]");
114    Tcl_AppendResult(interp, user, NULL);
115    return TCL_OK;
116}
117
118static HKEY
119regroot(root)
120    char *root;
121{
122    if (strcasecmp(root, "HKEY_LOCAL_MACHINE") == 0)
123        return HKEY_LOCAL_MACHINE;
124    else if (strcasecmp(root, "HKEY_CURRENT_USER") == 0)
125        return HKEY_CURRENT_USER;
126    else if (strcasecmp(root, "HKEY_USERS") == 0)
127        return HKEY_USERS;
128    else if (strcasecmp(root, "HKEY_CLASSES_ROOT") == 0)
129        return HKEY_CLASSES_ROOT;
130    else
131        return (HKEY)-1;
132}
133
134int
135WinReg(ClientData clientdata, Tcl_Interp *interp, int argc, char **argv)
136{
137        static char szBuf[255], szOutBuf[255];
138        char *szRegRoot = NULL, *szRegPath = NULL, *szValueName;
139        int cbOutBuf = 255;
140        HKEY hKey, hKeyResult;
141        DWORD dwDisp;
142
143        if (argc < 4 || argc > 5) {
144                Tcl_AppendResult(interp, "wrong number of args\n", szBuf, NULL);
145                return TCL_ERROR;
146        }
147
148        strncpy(szBuf, argv[2], 255);
149        szValueName = argv[3];
150        szRegRoot   = szBuf;
151        szRegPath   = strchr(szBuf, '\\');
152
153        if (szRegPath == NULL || szValueName == NULL) {
154                Tcl_AppendResult(interp, "registry path is wrongly written\n", szBuf, NULL);
155                return TCL_ERROR;
156        }
157
158        *szRegPath = '\x0';
159        szRegPath++;
160
161        hKey = regroot(szRegRoot);
162
163        if (hKey == (HKEY)-1) {
164                Tcl_AppendResult(interp, "root not found %s", szRegRoot, NULL);
165                return TCL_ERROR;
166        }
167
168        if (ERROR_SUCCESS != RegCreateKeyEx(hKey, szRegPath, 0, NULL, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, NULL, &hKeyResult, &dwDisp)) {
169                Tcl_AppendResult(interp, "Could not open key", szRegRoot, szRegPath, NULL);
170                return TCL_ERROR;
171        }
172
173        if (argc == 4 && !strcmp(argv[1],"get")) {
174                DWORD dwType = REG_SZ;
175                if (ERROR_SUCCESS != RegQueryValueEx(hKeyResult, szValueName, 0, &dwType, szOutBuf, &cbOutBuf)) {
176                        RegCloseKey(hKeyResult);
177                        Tcl_AppendResult(interp, "Could not set value", szValueName, NULL);
178                        return TCL_ERROR;
179                }
180                Tcl_SetResult(interp, szOutBuf, TCL_STATIC);
181        } else if (argc == 5 && !strcmp(argv[1], "set")) {
182                if (ERROR_SUCCESS != RegSetValueEx(hKeyResult, szValueName, 0, REG_SZ, argv[4], strlen(argv[4]))) {
183                        RegCloseKey(hKeyResult);
184                        Tcl_AppendResult(interp, "Could not set value", szValueName, argv[4], NULL);
185                        return TCL_ERROR;
186                }
187        }
188        RegCloseKey(hKeyResult);
189        return TCL_OK;
190}
191
192int
193RegGetValue(HKEY* key, char *subkey, char *value, char *dst, int dlen)
194{
195        HKEY lkey;
196        LONG r;
197        LONG len;
198        DWORD type;
199
200        r = RegOpenKeyEx(*key, subkey, 0, KEY_READ, &lkey);
201
202        if (ERROR_SUCCESS == r) {
203                r = RegQueryValueEx(lkey, value, 0, &type, NULL, &len);
204                if (ERROR_SUCCESS == r && len <= dlen && type == REG_SZ) {
205                        type = REG_SZ;
206                        r = RegQueryValueEx(lkey, value, 0, &type, dst, &len);
207                } else {
208                        SetLastError(r);
209                        perror("");
210                }
211        } else {
212                SetLastError(r);
213                perror("");
214                return FALSE;
215        }
216        RegCloseKey(lkey);
217        return TRUE;
218}
219#endif
220
221Tcl_Interp      *interp;        /* Interpreter for application. */
222char            *engine_addr;
223struct mbus     *mbus_ui;
224
225void
226tcl_send(char *command)
227{
228        /* This is called to send a message to the user interface...  */
229        /* If the UI is not enabled, the message is silently ignored. */
230        assert(command != NULL);
231
232        if (Tk_GetNumMainWindows() <= 0) {
233                return;
234        }
235
236        if (Tcl_Eval(interp, command) != TCL_OK) {
237                debug_msg("TCL error: %s\n", Tcl_GetVar(interp, "errorInfo", 0));
238        }
239}
240
241static int
242mbus_send_cmd(ClientData ttp, Tcl_Interp *i, int argc, char *argv[])
243{
244        if (argc != 4) {
245                i->result = "mbus_send <reliable> <cmnd> <args>";
246                return TCL_ERROR;
247        }
248        mbus_qmsg((struct mbus *)ttp, engine_addr, argv[2], argv[3], strcmp(argv[1], "R") == 0);
249        return TCL_OK;
250}
251
252static int
253mbus_encode_cmd(ClientData ttp, Tcl_Interp *i, int argc, char *argv[])
254{
255        UNUSED(ttp);
256        if (argc != 2) {
257                i->result = "mbus_encode_str <str>";
258                return TCL_ERROR;
259        }
260        Tcl_SetResult(i, mbus_encode_str(argv[1]), (Tcl_FreeProc *) xfree);
261        return TCL_OK;
262}
263
264#include "xbm/rat_small.xbm"
265#include "xbm/disk.xbm"
266#include "xbm/play.xbm"
267#include "xbm/rec.xbm"
268#include "xbm/pause.xbm"
269#include "xbm/stop.xbm"
270#include "xbm/left.xbm"
271#include "xbm/right.xbm"
272#include "xbm/balloon.xbm"
273#include "xbm/reception.xbm"
274
275static char*
276parse_assignment(char* cp)
277{
278        cp = strchr(cp, '=');
279        if (cp != 0) {
280                *cp = 0;
281                return (cp + 1);
282        } else
283                return ("true");
284}
285
286int
287tcl_init1(int argc, char **argv)
288{
289        char            *cmd_line_args, buffer[10];
290        Tcl_Obj         *audiotool_obj;
291        int             i;
292
293        Tcl_FindExecutable(argv[0]);
294        interp        = Tcl_CreateInterp();
295        cmd_line_args = Tcl_Merge(argc - 1, argv + 1);
296        Tcl_SetVar(interp, "argv", cmd_line_args, TCL_GLOBAL_ONLY);
297#ifndef WIN32
298        ckfree(cmd_line_args);
299#endif
300        sprintf(buffer, "%d", argc - 1);
301        Tcl_SetVar(interp, "argc", buffer, TCL_GLOBAL_ONLY);
302        Tcl_SetVar(interp, "argv0", argv[0], TCL_GLOBAL_ONLY);
303        Tcl_SetVar(interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
304        for(i=1; i<argc; i++ ) {
305                if( strcmp(argv[i],"-X") == 0) {
306                        const char* value = parse_assignment(argv[++i]);
307                        Tcl_SetVar(interp, argv[i], value, TCL_GLOBAL_ONLY);
308                }
309        }
310
311        /*
312         * There is no easy way of preventing the Init functions from
313         * loading the library files. Ignore error returns and load
314         * built in versions.
315         */
316        if (Tcl_Init(interp) != TCL_OK) {
317                fprintf(stderr, "%s\n", Tcl_GetStringResult(interp));
318                exit(-1);
319        }
320        if (Tk_Init(interp) != TCL_OK) {
321                fprintf(stderr, "%s\n", Tcl_GetStringResult(interp));
322                exit(-1);
323        }
324#ifdef WIN32
325        Tcl_SetVar(interp, "win32", "1", TCL_GLOBAL_ONLY);
326        Tcl_CreateCommand(interp, "puts",        WinPutsCmd,     NULL, NULL);
327        Tcl_CreateCommand(interp, "getusername", WinGetUserName, NULL, NULL);
328        Tcl_CreateCommand(interp, "registry",    WinReg,         NULL, NULL);
329#else
330        Tcl_SetVar(interp, "win32", "0", TCL_GLOBAL_ONLY);
331#endif
332        Tk_DefineBitmap(interp, Tk_GetUid("rat_small"), rat_small_bits, rat_small_width, rat_small_height);
333        Tk_DefineBitmap(interp, Tk_GetUid("disk"), disk_bits, disk_width, disk_height);
334        Tk_DefineBitmap(interp, Tk_GetUid("play"), play_bits, play_width, play_height);
335        Tk_DefineBitmap(interp, Tk_GetUid("rec"),  rec_bits,  rec_width,  rec_height);
336        Tk_DefineBitmap(interp, Tk_GetUid("pause"), pause_bits, pause_width, pause_height);
337        Tk_DefineBitmap(interp, Tk_GetUid("stop"),  stop_bits,  stop_width,  stop_height);
338        //SV-XXX cast 3rd argument to (char *)
339        Tk_DefineBitmap(interp, Tk_GetUid("left"),  (char *) left_bits,  left_width, left_height);
340        Tk_DefineBitmap(interp, Tk_GetUid("right"), (char *) right_bits, right_width,  right_height);
341        Tk_DefineBitmap(interp, Tk_GetUid("balloon"), (char *) balloon_bits, balloon_width,  balloon_height);
342        Tk_DefineBitmap(interp, Tk_GetUid("reception"), (char *) reception_bits, reception_width,  reception_height);
343
344        audiotool_obj = Tcl_NewStringObj(ui_audiotool, strlen(ui_audiotool));
345        if (Tcl_EvalObj(interp, audiotool_obj) != TCL_OK) {
346                fprintf(stderr, "ui_audiotool error: %s\n", Tcl_GetStringResult(interp));
347        }
348        while (Tcl_DoOneEvent(TCL_DONT_WAIT | TCL_ALL_EVENTS)) {
349                /* Process Tcl/Tk events */
350        }
351
352        return TRUE;
353}
354
355int
356tcl_init2(struct mbus *mbus_ui, char *mbus_engine_addr)
357{
358        engine_addr   = xstrdup(mbus_engine_addr);
359
360        //SV-XXX: NetBSD: added cast to (Tcl_CmdProc *) for 3rd argument
361        Tcl_CreateCommand(interp, "mbus_send",       (Tcl_CmdProc *)mbus_send_cmd,   (ClientData) mbus_ui, NULL);
362        Tcl_CreateCommand(interp, "mbus_encode_str", (Tcl_CmdProc *)mbus_encode_cmd, NULL, NULL);
363
364        /* Process Tcl/Tk events */
365        while (Tcl_DoOneEvent(TCL_DONT_WAIT | TCL_ALL_EVENTS)) {
366                /* Process Tcl/Tk events */
367        }
368        Tcl_ResetResult(interp);
369
370        /* We do this last, so it is executed within the main loop... */
371        Tcl_Eval(interp, "rendezvous_with_media_engine");
372        return TRUE;
373}
374
375void
376tcl_exit()
377{
378        xfree(engine_addr);
379}
Note: See TracBrowser for help on using the browser.