Main Page | Modules | Alphabetical List | Data Structures | File List | Data Fields | Related Pages

hooker.c

00001 /* Copyright (C) 1997-2004 The CDG Team <cdg@nats.informatik.uni-hamburg.de> 00002 * 00003 * This file is free software; as a special exception the author gives 00004 * unlimited permission to copy and/or distribute it, with or without 00005 * modifications, as long as this notice is preserved. 00006 * 00007 * This program is distributed in the hope that it will be useful, but 00008 * WITHOUT ANY WARRANTY, to the extent permitted by law; without even the 00009 * implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00010 * 00011 * Author: Michael Schulz (see also AUTHORS and THANKS for more) 00012 * Birth: 12 Juli 1998 00013 */ 00014 00015 /* ------------------------------------------------------------------------- 00016 * @addtogroup HookBindings HookBindings - Adaptor to the callback system 00017 * @ingroup Hook 00018 * @{ 00019 * \todo Please explain this module. 00020 */ 00021 00022 #include <stdlib.h> 00023 #include <stdio.h> 00024 #include <string.h> 00025 #include "config.h" 00026 #include "blah.h" 00027 #include "hooker.h" 00028 #include "netsearch.h" 00029 #include "parse.h" 00030 #include "swig_utils.h" 00031 00032 /* -- VARIABLES --------------------------------------------------------- */ 00033 00034 00035 /* -------------------------------------------------------------------------- 00036 * pointer to the currently used tcl interpreter. 00037 * \todo This pointer isn't needed for newer swigs. 00038 */ 00039 Tcl_Interp *hkInterp; 00040 00041 /* -------------------------------------------------------------------------- 00042 * the singelton Logger instance used in this module. 00043 */ 00044 static Logger logger; 00045 00046 /* -------------------------------------------------------------------------- 00047 * typed hook result. 00048 * This pointer is used in our special typemaps. 00049 */ 00050 HookResult hkResult; 00051 00052 /* --------------------------------------------------------------------------- 00053 * to be called by every hook. 00054 */ 00055 static void initHookResult(Hook hook) 00056 { 00057 hkResult->type = HTNone; 00058 hkResult->hook = hook; 00059 hkResult->data.intResult = 0; 00060 hkResult->data.stringResult = NULL; 00061 } 00062 00063 /* --------------------------------------------------------------------------- 00064 * initialize the module when loading 00065 * this stores the tcl-hooks cdgHooks 00066 */ 00067 void hooker_init(Tcl_Interp *interp) 00068 { 00069 Hook hook; 00070 int i; 00071 00072 logger = (Logger) memMalloc(sizeof (LoggerStruct)); 00073 logger->size = 0; 00074 logger->maxsize = 0; 00075 logger->buffer = NULL; 00076 hkInterp = interp; 00077 hkResult = (HookResult) memMalloc(sizeof (HookResultStruct)); 00078 initHookResult(NULL); 00079 loggerSize(1024); 00080 00081 for (i = 0; i < vectorSize(hkHooks); i++) { 00082 hook = (Hook) vectorElement(hkHooks, i); 00083 hook->cmd = NULL; 00084 hook->function = (HookFunction *) tclHookHandle; 00085 } 00086 00087 hook = vectorElement(hkHooks, HOOK_PRINTF); 00088 hook->function = (HookFunction *) logPrintf; 00089 hook->cmd = strCopy("puts -nonewline"); 00090 00091 hook = vectorElement(hkHooks, HOOK_FLUSH); 00092 hook->function = (HookFunction *) logFlush; 00093 hook->cmd = NULL; 00094 00095 hook = vectorElement(hkHooks, HOOK_EVAL); 00096 hook->function = (HookFunction *) evalHookHandle; 00097 hook->cmd = NULL; 00098 00099 hook = vectorElement(hkHooks, HOOK_NSSEARCH); 00100 hook->function = (HookFunction *) netsearchHookHandle; 00101 hook->cmd = NULL; 00102 00103 hook = vectorElement(hkHooks, HOOK_GLSINTERACTION); 00104 hook->function = (HookFunction *) glsInteractionHookHandle; 00105 hook->cmd = NULL; 00106 00107 hook = vectorElement(hkHooks, HOOK_GETS); 00108 hook->function = (HookFunction *) getsHookHandle; 00109 hook->cmd = NULL; 00110 00111 hook = vectorElement(hkHooks, HOOK_PROGRESS); 00112 hook->function = (HookFunction *) progressHookHandle; 00113 hook->cmd = NULL; 00114 00115 hook = vectorElement(hkHooks, HOOK_PARTIALRESULT); 00116 hook->function = (HookFunction *) partialResultHookHandle; 00117 hook->cmd = NULL; 00118 00119 hook = vectorElement(hkHooks, HOOK_ICINTERACTION); 00120 hook->function = (HookFunction *) ICinteractionHookHandle; 00121 hook->cmd = NULL; 00122 00123 hook = vectorElement(hkHooks, HOOK_RESET); 00124 hook->function = (HookFunction *) tclHookHandle; 00125 hook->cmd = NULL; 00126 00127 } 00128 00129 /* --------------------------------------------------------------------------- 00130 * set the buffersize of the logger. 00131 * \param maxsize the size which to set the log buffer to. 00132 * \returns the old size of the log buffer. 00133 */ 00134 int loggerSize(int maxsize) 00135 { 00136 int oldSize = logger->maxsize; 00137 00138 if (maxsize < 2) 00139 maxsize = 2; 00140 00141 logger->maxsize = maxsize; 00142 logger->buffer = (char *)memRealloc(logger->buffer, maxsize + 1); 00143 logger->buffer[logger->size] = 0; 00144 00145 return oldSize; 00146 } 00147 00148 /* --------------------------------------------------------------------------- 00149 * write a char to the logger. 00150 * This functions writes a single char and check if it is a specail char 00151 * which should be escaped. 00152 */ 00153 TclResultType logWriteChar(char c) 00154 { 00155 #define DEBUG_WRITECHAR 0 00156 int n = 0; 00157 00158 initHookResult(NULL); 00159 00160 /* escape some substitution */ 00161 if (c == '[' || c == ']' || c == '$' || c == '\\' || c == '"') { 00162 if (logger->size + 1 >= logger->maxsize) { 00163 if (logFlush() == TCL_ERROR) { 00164 /* logFlush generated the error message */ 00165 return TCL_ERROR; 00166 } 00167 } 00168 logger->buffer[logger->size++] = '\\'; 00169 n++; 00170 } 00171 #if DEBUG_WRITECHAR 00172 putchar(c); 00173 #endif 00174 logger->buffer[logger->size++] = c; 00175 logger->buffer[logger->size] = 0; 00176 00177 if (logger->size >= logger->maxsize || c == '\n') { 00178 if (logFlush() == TCL_ERROR) { 00179 /* logFlush generated the error message */ 00180 return TCL_ERROR; 00181 } 00182 n++; 00183 } 00184 00185 hkResult->type = HTInt; 00186 hkResult->data.intResult = n; 00187 00188 return TCL_OK; 00189 } 00190 00191 /* --------------------------------------------------------------------------- 00192 * logWrite: writes some text into the logger 00193 */ 00194 TclResultType logWrite(char *text) 00195 { 00196 int len = strlen(text); 00197 int n = 0; 00198 int i; 00199 00200 for (i = 0; i < len; i++) { 00201 if (logWriteChar(text[i]) == TCL_ERROR) { 00202 /* logFlush generated the error message */ 00203 return TCL_ERROR; 00204 } 00205 n += hkResult->data.intResult; 00206 } 00207 00208 hkResult->type = HTInt; 00209 hkResult->data.intResult = n; 00210 00211 return TCL_OK; 00212 } 00213 00214 /* --------------------------------------------------------------------------- 00215 * setHookCmd: set the tcl-command of a named hook 00216 */ 00217 TclResultType setHookCmd(char *hookName, char *cmd) 00218 { 00219 int hookNo; 00220 Hook hook; 00221 00222 initHookResult(NULL); 00223 00224 hookNo = hkFindNoOfHook(hookName); 00225 if (hookNo < 0) { 00226 Tcl_Obj *tclResult = Tcl_GetObjResult(hkInterp); 00227 Tcl_AppendStringsToObj(tclResult, "don't know hook `", hookName, "'", 00228 (char *)NULL); 00229 return TCL_ERROR; 00230 } 00231 00232 hook = (Hook) vectorElement(hkHooks, hookNo); 00233 00234 if (strlen(cmd) == 0) 00235 hook->cmd = NULL; 00236 else 00237 hook->cmd = strCopy(cmd); 00238 00239 return TCL_OK; 00240 } 00241 00242 /* --------------------------------------------------------------------------- 00243 * getHookCmd: get the tcl-command of a named hook 00244 */ 00245 TclResultType getHookCmd(char *hookName) 00246 { 00247 int hookNo; 00248 Hook hook; 00249 00250 hookNo = hkFindNoOfHook(hookName); 00251 if (hookNo < 0) { 00252 Tcl_Obj *tclResult = Tcl_GetObjResult(hkInterp); 00253 Tcl_AppendStringsToObj(tclResult, "don't know hook `", hookName, "'", (char *)NULL); 00254 return TCL_ERROR; 00255 } 00256 00257 hook = (Hook) vectorElement(hkHooks, hookNo); 00258 hkResult->hook = hook; 00259 hkResult->type = HTString; 00260 hkResult->data.stringResult = hook->cmd; 00261 00262 return TCL_OK; 00263 } 00264 00265 /* --------------------------------------------------------------------------- 00266 * logPrintf: print formated text into the logger 00267 */ 00268 TclResultType logPrintf(char *format, va_list ap) 00269 { 00270 int result = logWrite(strVPrintf(format, ap)); 00271 hkResult->hook = vectorElement(hkHooks, HOOK_PRINTF); 00272 return result; 00273 } 00274 00275 /* --------------------------------------------------------------------------- 00276 * logFlush: flush the logwindow 00277 */ 00278 TclResultType logFlush() 00279 { 00280 int result = TCL_OK; 00281 Hook hook; 00282 00283 hook = vectorElement(hkHooks, HOOK_PRINTF); 00284 initHookResult(hook); 00285 if (hook && hook->cmd) { 00286 result = Tcl_VarEval(hkInterp, hook->cmd, 00287 " \"", logger->buffer, "\" ", (char *)NULL); 00288 } 00289 00290 if (result == TCL_OK) { 00291 hook = vectorElement(hkHooks, HOOK_FLUSH); 00292 initHookResult(hook); 00293 if (hook && hook->cmd) { 00294 result = Tcl_VarEval(hkInterp, hook->cmd, (char *)NULL); 00295 } 00296 } 00297 00298 logger->buffer[0] = 0; 00299 logger->size = 0; 00300 00301 if (result != TCL_OK) { 00302 hkResult->type = HTError; 00303 } 00304 00305 return (result); 00306 } 00307 00308 /* --------------------------------------------------------------------------- 00309 * netsearchHookHandle: 00310 * arg1: NetSearchState 00311 * arg3: mode 00312 * 1 - add rootnode 00313 * 2 - solution node found 00314 * 3 - add child 00315 * 4 - add skipper 00316 * 5 - widen searchspace 00317 * 6 - closing open node 00318 */ 00319 TclResultType netsearchHookHandle(Hook hook, va_list ap) 00320 { 00321 int result; 00322 int mode; 00323 Pointer p1; 00324 char b1[512], b2[512]; 00325 00326 if (!hook->cmd) 00327 return TCL_OK; 00328 00329 initHookResult(hook); 00330 00331 /* parse arguments */ 00332 p1 = va_arg(ap, Pointer); 00333 mode = va_arg(ap, int); 00334 00335 /* convert to ascii representation */ 00336 SWIG_MakePtr(b1, p1, "_NetSearchState"); 00337 sprintf(b2, "%d", mode); 00338 00339 /* execute command */ 00340 result = Tcl_VarEval(hkInterp, hook->cmd, " ", b1, " ", b2, (char *)NULL); 00341 00342 /* exception handling */ 00343 if (result != TCL_OK) { 00344 hkResult->type = HTError; 00345 } 00346 00347 return result; 00348 } 00349 00350 /* --------------------------------------------------------------------------- 00351 * evalHookHandle: 00352 * called inside evalConstraint when a constraint fails 00353 * the constraint can be unary or binary; levelvalues are still assigned 00354 * arg1 : constraint 00355 */ 00356 TclResultType evalHookHandle(Hook hook, va_list ap) 00357 { 00358 int result; 00359 Pointer p1; 00360 char b1[512]; 00361 00362 if (!hook->cmd) 00363 return TCL_OK; 00364 00365 initHookResult(hook); 00366 00367 /* parse arguments */ 00368 p1 = va_arg(ap, Pointer); 00369 00370 /* convert to ascii representation */ 00371 SWIG_MakePtr(b1, p1, "_Constraint"); 00372 00373 /* execute command */ 00374 result = Tcl_VarEval(hkInterp, hook->cmd, " ", b1, (char *)NULL); 00375 00376 /* exception handling */ 00377 if (result != TCL_OK) { 00378 hkResult->type = HTError; 00379 } 00380 00381 return result; 00382 } 00383 00384 /* --------------------------------------------------------------------------- 00385 * glsInteractionHookHandle: 00386 * called inside the gls-module when a interaction with the algorithm 00387 * is desired 00388 * arg1 : GlsNet glsNet 00389 * arg2 : String message 00390 */ 00391 TclResultType glsInteractionHookHandle(Hook hook, va_list ap) 00392 { 00393 int result; 00394 Pointer glsNet; 00395 char *message; 00396 char b1[512]; 00397 00398 if (!hook->cmd) 00399 return TCL_OK; 00400 00401 initHookResult(hook); 00402 00403 /* parse arguments */ 00404 glsNet = va_arg(ap, Pointer); 00405 message = va_arg(ap, char *); 00406 00407 /* convert to ascii representation */ 00408 SWIG_MakePtr(b1, glsNet, "_Pointer"); 00409 00410 /* execute command */ 00411 result = Tcl_VarEval(hkInterp, hook->cmd, " ", b1, " {", message, "}", 00412 (char *)NULL); 00413 00414 /* exception handling */ 00415 if (result != TCL_OK) { 00416 hkResult->type = HTError; 00417 } 00418 00419 return result; 00420 } 00421 00422 /* --------------------------------------------------------------------------- 00423 * getsHookHandle: 00424 * handle gets from within tcl 00425 */ 00426 TclResultType getsHookHandle(Hook hook, String buffer, int size) 00427 { 00428 int result; 00429 00430 if (!hook->cmd) 00431 return TCL_OK; 00432 00433 initHookResult(hook); 00434 00435 /* execute command */ 00436 result = Tcl_VarEval(hkInterp, hook->cmd, (char *)NULL); 00437 00438 /* exception handling */ 00439 if (result != TCL_OK) { 00440 hkResult->type = HTError; 00441 } else { 00442 strncpy(buffer, hkInterp->result, size); 00443 } 00444 00445 return result; 00446 } 00447 00448 /* --------------------------------------------------------------------------- 00449 * progressHookHandle: 00450 * show progess messages in tcl 00451 */ 00452 TclResultType progressHookHandle(Hook hook, char *format, va_list ap) 00453 { 00454 int result; 00455 char buffer[1024]; 00456 00457 if (!hook->cmd) 00458 return TCL_OK; 00459 00460 initHookResult(hook); 00461 00462 /* generate string */ 00463 vsnprintf(buffer, 1024, format, ap); 00464 00465 /* execute command */ 00466 result = Tcl_VarEval(hkInterp, hook->cmd, " {", buffer, "}", (char *)NULL); 00467 00468 /* exception handling */ 00469 if (result != TCL_OK) { 00470 hkResult->type = HTError; 00471 } 00472 00473 return result; 00474 } 00475 00476 00477 00478 /* --------------------------------------------------------------------------- 00479 * partialResultHookHandle: 00480 * order displaying of another Parse 00481 */ 00482 TclResultType partialResultHookHandle(Hook hook, va_list ap) 00483 { 00484 int result; 00485 char b1[512]; 00486 Parse parse; 00487 00488 if (!hook->cmd) 00489 return TCL_OK; 00490 00491 initHookResult(hook); 00492 00493 /* convert to ascii representation */ 00494 parse = (Parse) va_arg(ap, Parse); 00495 SWIG_MakePtr(b1, parse, "_Parse"); 00496 00497 /* execute command */ 00498 result = Tcl_VarEval(hkInterp, hook->cmd, " ", b1, (char *)NULL); 00499 00500 /* exception handling */ 00501 if (result != TCL_OK) { 00502 hkResult->type = HTError; 00503 } 00504 00505 return result; 00506 } 00507 00508 /* --------------------------------------------------------------------------- 00509 * ICinteractionHookHandle: 00510 * get another word from the IC textbox. 00511 */ 00512 TclResultType ICinteractionHookHandle(Hook hook, va_list ap) 00513 { 00514 int result; 00515 String buffer; 00516 00517 buffer = va_arg(ap, String); 00518 00519 if (!hook->cmd) 00520 return TCL_OK; 00521 00522 initHookResult(hook); 00523 00524 /* execute command */ 00525 result = Tcl_VarEval(hkInterp, hook->cmd, (char *)NULL); 00526 00527 /* exception handling */ 00528 if (result != TCL_OK) { 00529 hkResult->type = HTError; 00530 } else { 00531 strcpy(buffer, hkInterp->result); 00532 } 00533 00534 return result; 00535 } 00536 00537 /* --------------------------------------------------------------------------- 00538 Call the Tcl-specified command, with no arguments. 00539 */ 00540 TclResultType resetHookHandle(Hook hook, va_list ap) { 00541 int result; 00542 char b1[512]; 00543 Parse parse; 00544 00545 if (!hook->cmd) 00546 return TCL_OK; 00547 00548 initHookResult(hook); 00549 00550 /* execute command */ 00551 result = Tcl_VarEval(hkInterp, hook->cmd, " ", (char *)NULL); 00552 00553 /* exception handling */ 00554 if (result != TCL_OK) { 00555 hkResult->type = HTError; 00556 } 00557 00558 return result; 00559 00560 } 00561 00562 00563 00564 /* --------------------------------------------------------------------------- 00565 * tclHookHandle: default tclHook-Handler 00566 * arguments aren't used 00567 */ 00568 TclResultType tclHookHandle(Hook hook, va_list ap) 00569 { 00570 int result; 00571 00572 if (!hook->cmd) 00573 return TCL_OK; 00574 00575 initHookResult(hook); 00576 00577 /* execute command */ 00578 result = Tcl_VarEval(hkInterp, hook->cmd, (char *)NULL); 00579 00580 /* exception handling */ 00581 if (result != TCL_OK) { 00582 hkResult->type = HTError; 00583 } 00584 00585 return result; 00586 } 00587 00588 /* ---------------------------------------------------------------------- */ 00589 /* -- ENDOFFILE --------------------------------------------------------- */ 00590 /** @} */

CDG 0.95 (20 Oct 2004)