1 /* # skkinput (Simple Kana-Kanji Input)
2 *
3 * This file is part of skkinput.
4 * Copyright (C) 2002
5 * Takashi SAKAMOTO (PXG01715@nifty.ne.jp)
6 *
7 * This program is free software; you can redistribute it and/or modify
8 * it under the terms of the GNU General Public License as published by
9 * the Free Software Foundation; either version 2, or (at your option)
10 * any later version.
11 *
12 * This program is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with skkinput; see the file COPYING. If not, write to
19 * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
20 */
21 #include "AfxWin.h"
22 #include "dispatch.h"
23 #include <assert.h>
24 #include <stdarg.h>
25 #include "lmachinep.h"
26 #include "lispmgrp.h"
27 #include "TTerminal.h"
28 #include "TFrame.h"
29 #include "TNormalFrame.h"
30 #include "TLispClient.h"
31
32 /* Prototypes
33 */
34 static Boolean tLispClient_initialize (TLispClient*, TLispManager*, TLispMachine*, Widget, Widget) ;
35 static Boolean tLispClient_createMinibuffer(TLispMachine*, TLispEntity**) ;
36 static Boolean tLispClient_createFrame (TLispMachine*, Widget, Widget, TLispEntity*, TLispEntity*) ;
37 static void tLispClient_postInitialize (TLispClient*) ;
38 static Boolean tLispClient_tickAll (void) ;
39 static void tLispClient_register (TLispClient*) ;
40 static void tLispClient_unregister (TLispClient*) ;
41 static void tLispClient_updateParent (TLispMachine*) ;
42 static Boolean tLispClient_parseAndEval (TLispMachine*, const char*, ...) ;
43 #if defined (USE_BLOCKHOOK)
44 static Boolean tLispClient_workHook (XtPointer) ;
45 #endif
46
47 /* Local Global Variables
48 */
49 static TLispClient* slstLispClient = NULL ;
50 #if defined (USE_BLOCKHOOK)
51 static volatile Boolean sfRunGC ;
52 static volatile int snNeedToRunGC ;
53 #endif
54
55 /*
56 */
57 void
TLispClient_MainLoop(register XtAppContext appcontext,register TLispMachine * pTopLM,register int (* pGetExitFlagProc)(void))58 TLispClient_MainLoop (
59 register XtAppContext appcontext,
60 register TLispMachine* pTopLM,
61 register int (*pGetExitFlagProc)(void))
62 {
63 register Boolean fBlock = True ;
64 XEvent xev ;
65 #if defined (USE_BLOCKHOOK)
66 register XtWorkProcId nID = 0 ;
67 register TLispManager* pLispMgr = pTopLM->m_pLispMgr ;
68 #endif
69
70 assert (pTopLM != NULL) ;
71 assert (pGetExitFlagProc != NULL) ;
72
73 #if defined (USE_BLOCKHOOK)
74 sfRunGC = False ;
75 snNeedToRunGC = 0 ;
76 #endif
77
78 while (! (*pGetExitFlagProc)()) {
79 if (fBlock) {
80 XtAppNextEvent (appcontext, &xev) ;
81 AfxDispatchEvent (&xev) ;
82 } else {
83 while (XtAppPending (appcontext) != 0) {
84 XtAppNextEvent (appcontext, &xev) ;
85 AfxDispatchEvent (&xev) ;
86 }
87 }
88 fBlock = tLispClient_tickAll () ;
89 #if defined (USE_BLOCKHOOK)
90 if (snNeedToRunGC > 0 && !sfRunGC) {
91 nID = XtAppAddWorkProc (appcontext, tLispClient_workHook, pLispMgr) ;
92 sfRunGC = True ;
93 }
94 #endif
95 }
96 #if defined (USE_BLOCKHOOK)
97 if (sfRunGC) {
98 XtRemoveWorkProc (nID) ;
99 sfRunGC = False ;
100 }
101 #endif
102 return ;
103 }
104
105 /*
106 */
107 Boolean
TLispClient_ClassInitialize(register TLispManager ** ppLispMgr,register TLispMachine ** ppLM,register const char * pStrConfigPath,register const char * pStrServerHost,register int nPortNum,register Boolean fCreateLispMgr)108 TLispClient_ClassInitialize (
109 register TLispManager** ppLispMgr,
110 register TLispMachine** ppLM,
111 register const char* pStrConfigPath,
112 register const char* pStrServerHost,
113 register int nPortNum,
114 register Boolean fCreateLispMgr)
115 {
116 TLispManager* pLispMgr ;
117 TLispMachine* pLM ;
118 TLispEntity* pEntBuffer ;
119 register const char* pPath ;
120
121 if (fCreateLispMgr) {
122 if (TFAILED (TLispMgr_Create (&pLispMgr)))
123 return False ;
124 } else {
125 if (ppLispMgr == NULL || *ppLispMgr == NULL)
126 return False ;
127 pLispMgr = *ppLispMgr ;
128 }
129 if (TFAILED (TLispMachine_Create (pLispMgr, NULL, &pLM)))
130 return False ;
131
132 lispMgr_CreateBuffer (pLispMgr, &pEntBuffer) ;
133 lispMachine_InsertBuffer (pLM, pEntBuffer) ;
134 lispMachineCode_SetCurrentBuffer (pLM, pEntBuffer) ;
135
136 pPath = (pStrConfigPath == NULL || *pStrConfigPath == '\0')? "." : pStrConfigPath ;
137 if (TFAILED (tLispClient_parseAndEval (pLM, "(setq load-path '(\"%s\"))", pPath)) ||
138 TFAILED (tLispClient_parseAndEval (pLM, "(load \"init.el\")")))
139 return False ;
140 if (pStrServerHost != NULL &&
141 *pStrServerHost != '\0' &&
142 TFAILED (tLispClient_parseAndEval (pLM, "(setq skk-server-host \"%s\")", pStrServerHost)))
143 return False ;
144 if (nPortNum >= 0 &&
145 TFAILED (tLispClient_parseAndEval (pLM, "(setq skk-portnum %d)", nPortNum)))
146 return False ;
147
148 *ppLispMgr = pLispMgr ;
149 *ppLM = pLM ;
150 return True ;
151 }
152
153 void
TLispClient_ClassFinalize(register TLispMachine * pLM)154 TLispClient_ClassFinalize (
155 register TLispMachine* pLM)
156 {
157 static const char sstrEND [] = "(mutual-eval skk-jisyo-mutex '(progn (setq this-command 'save-buffers-kill-emacs) (skk-save-jisyo)))" ;
158 register TLispManager* pLispMgr ;
159 register TLispEntity* pEntTarget ;
160
161 #if defined (DEBUG)
162 fprintf (stderr, "TLispClient_ClassFinalize (%p)\n", pLM) ;
163 #endif
164 assert (pLM != NULL) ;
165 pLispMgr = pLM->m_pLispMgr ;
166 assert (pLispMgr != NULL) ;
167 pEntTarget = lispMgr_ParseStringA (pLispMgr, sstrEND, NELEMENTS (sstrEND) - 1, NULL) ;
168 assert (pEntTarget != NULL) ;
169 TLispMachine_Test (pLM, pEntTarget) ;
170 return ;
171 }
172
173 void
TLispClient_PreInitialize(register TLispClient * pClient)174 TLispClient_PreInitialize (
175 register TLispClient* pClient)
176 {
177 assert (pClient != NULL) ;
178 pClient->m_pLM = NULL ;
179 pClient->m_pNext = NULL ;
180 return ;
181 }
182
183 Boolean
TLispClient_Initialize(register TLispClient * pClient,register TLispClientArg * pArg)184 TLispClient_Initialize (
185 register TLispClient* pClient,
186 register TLispClientArg* pArg)
187 {
188 register TLispManager* pLispMgr ;
189 register TLispMachine* pParentLM ;
190 register TLispMachine* pLM ;
191 TLispEntity* pEntClient ;
192 static const char sstrClient [] = "im-client" ;
193
194 assert (pClient != NULL) ;
195 assert (pArg != NULL) ;
196 pLispMgr = pArg->m_pLispMgr ;
197 pParentLM = pArg->m_pLM ;
198 assert (pLispMgr != NULL) ;
199
200 if (TFAILED (tLispClient_initialize (pClient, pLispMgr, pParentLM, pArg->m_wgFrame, pArg->m_wgMinibufFrame)))
201 return False ;
202
203 /* im-client �Ȥ��Ƥν������ɬ�פǤʤ���С������ǽ������롣*/
204 if (pArg->m_pvClient == NULL)
205 return True ;
206
207 /* im-client entity ��������롣*/
208 if (TFAILED (lispMgr_CreateIMClient (pLispMgr, pArg->m_pvClient, pArg->m_pKeyNotify, pArg->m_pTextNotify, pArg->m_pEndNotify, &pEntClient))) {
209 return False ;
210 }
211 lispEntity_AddRef (pLispMgr, pEntClient) ;
212
213 /* symbol: im-client �� im-client entity �� bind ���롣*/
214 pLM = pClient->m_pLM ;
215 lispMachine_SetCurrentSymbolValueWithNameA (pLM, sstrClient, NELEMENTS (sstrClient) - 1, pEntClient) ;
216 lispEntity_Release (pLispMgr, pEntClient) ;
217
218 tLispClient_register (pClient) ;
219 return True ;
220 }
221
222 void
TLispClient_Uninitialize(register TLispClient * pClient)223 TLispClient_Uninitialize (
224 register TLispClient* pClient)
225 {
226 register TLispMachine* pLM = pClient->m_pLM ;
227
228 if (pLM != NULL) {
229 register TLispManager* pLispMgr = pLM->m_pLispMgr ;
230
231 tLispClient_updateParent (pLM) ;
232 TLispMachine_Destroy (pLM) ;
233 pClient->m_pLM = NULL ;
234 #if defined (DEBUG)
235 fprintf (stderr, "Garbage Collecting ... ") ;
236 fflush (stderr) ;
237 #endif
238 lispMgr_CollectGarbage (pLispMgr) ;
239 lispMgr_CollectGarbage (pLispMgr) ;
240 lispMgr_CollectGarbage (pLispMgr) ;
241 lispMgr_CollectGarbage (pLispMgr) ;
242 #if defined (DEBUG)
243 fprintf (stderr, "done\n") ;
244 #endif
245 /* �द�������ξ�����ή�ˤҤäѤꤢ���ʤ��Ȥޤ����ʤ���
246 */
247 }
248 tLispClient_unregister (pClient) ;
249 return ;
250 }
251
252 void
TLispClient_Reinitialize(register TLispClient * pClient)253 TLispClient_Reinitialize (
254 register TLispClient* pClient)
255 {
256 assert (pClient != NULL) ;
257 assert (pClient->m_pLM != NULL) ;
258 lispMachine_ScheduleUpdateAllFrame (pClient->m_pLM) ;
259 return ;
260 }
261
262 Boolean
TLispClient_Tick(register TLispClient * pClient)263 TLispClient_Tick (
264 register TLispClient* pClient)
265 {
266 register TLispMachine* pLM = pClient->m_pLM ;
267 register TLMRESULT res ;
268 register Boolean fRetval = True ;
269
270 if (!TLispClient_Modifiedp (pClient))
271 return True ;
272
273 res = lispMachine_ExecuteLoop (pLM) ;
274 if (res != LMR_DESTROYED) {
275 #if defined (USE_BLOCKHOOK)
276 if (res == LMR_TICK) {
277 fRetval = False ;
278 } else {
279 TLispClient_SetModificationFlag (pClient, False) ;
280 }
281 /* ���ʤ� dirty �ʥ����ɤ�����������ˤ�������*/
282 lispMachine_UpdateAllFrame (pLM) ;
283 snNeedToRunGC ++ ;
284 #else
285 if (res == LMR_TICK) {
286 fRetval = False ;
287 } else {
288 TLispClient_SetModificationFlag (pClient, False) ;
289
290 /* ���ʤ� dirty �ʥ����ɤ�����������ˤ�������*/
291 lispMachine_UpdateAllFrame (pLM) ;
292
293 /*lispMachine_UpdateCurrentFrame (pClient->m_pLM) ;*/
294 /* ������4��Entity �⤬���줿���������Ȼפ��Τǡ�
295 * ������ GC ��ư�����٤��ʤΤ��� ���������ͤ��Ѱդ��٤�
296 * ���Ȥϻפ����ɡ�*/
297 lispMgr_CollectGarbage (pLM->m_pLispMgr) ;
298 }
299 #endif
300 }
301 return fRetval ;
302 }
303
304 void
TLispClient_Activate(register TLispClient * pClient,register Boolean fActive)305 TLispClient_Activate (
306 register TLispClient* pClient,
307 register Boolean fActive)
308 {
309 assert (pClient != NULL) ;
310 assert (pClient->m_pLM != NULL) ;
311 lispMachine_ActivateAllFrame (pClient->m_pLM, fActive) ;
312 return ;
313 }
314
315 Boolean
TLispClient_Modifiedp(register TLispClient * pClient)316 TLispClient_Modifiedp (
317 register TLispClient* pClient)
318 {
319 return pClient->m_fModify ;
320 }
321
322 void
TLispClient_SetModificationFlag(register TLispClient * pClient,register Boolean fModificationFlag)323 TLispClient_SetModificationFlag (
324 register TLispClient* pClient,
325 register Boolean fModificationFlag)
326 {
327 pClient->m_fModify = fModificationFlag ;
328 return ;
329 }
330
331 Boolean
tLispClient_initialize(register TLispClient * pClient,register TLispManager * pLispMgr,register TLispMachine * pMacParent,register Widget wgFrame,register Widget wgMinibufFrame)332 tLispClient_initialize (
333 register TLispClient* pClient,
334 register TLispManager* pLispMgr,
335 register TLispMachine* pMacParent,
336 register Widget wgFrame,
337 register Widget wgMinibufFrame)
338 {
339 register TLispMachine* pLM ;
340 TLispEntity* pEntBuffer ;
341 TLispEntity* pEntMinibuf ;
342
343 assert (pClient != NULL) ;
344 assert (pLispMgr != NULL) ;
345
346 if (TFAILED (TLispMachine_Create (pLispMgr, pMacParent, &pClient->m_pLM)))
347 return False ;
348
349 pLM = pClient->m_pLM ;
350 /* Buffer ��������롣*/
351 if (TFAILED (lispMgr_CreateBuffer (pLispMgr, &pEntBuffer)))
352 return False ;
353 lispMachine_InsertBuffer (pClient->m_pLM, pEntBuffer) ;
354 lispMachineCode_SetCurrentBuffer (pClient->m_pLM, pEntBuffer) ;
355
356 if (TFAILED (tLispClient_createMinibuffer (pLM, &pEntMinibuf))) {
357 lispMachine_RemoveBuffer (pLM, pEntBuffer) ;
358 return False ;
359 }
360 if (TFAILED (tLispClient_createFrame (pLM, wgFrame, wgMinibufFrame, pEntBuffer, pEntMinibuf))) {
361 lispMachine_RemoveBuffer (pLM, pEntBuffer) ;
362 lispMachine_RemoveBuffer (pLM, pEntMinibuf) ;
363 return False ;
364 }
365 tLispClient_postInitialize (pClient) ;
366 return True ;
367 }
368
369 Boolean
tLispClient_createMinibuffer(register TLispMachine * pLM,register TLispEntity ** ppEntMinibuf)370 tLispClient_createMinibuffer (
371 register TLispMachine* pLM,
372 register TLispEntity** ppEntMinibuf)
373 {
374 register TLispManager* pLispMgr = pLM->m_pLispMgr ;
375 TLispEntity* pEntNil ;
376 TLispEntity* pEntMinibuf ;
377 TLispEntity* pEntModeline ;
378
379 assert (pLM != NULL) ;
380 assert (ppEntMinibuf != NULL) ;
381
382 /* Minibuffer ��������롣*/
383 if (TFAILED (lispMgr_CreateBuffer (pLispMgr, &pEntMinibuf)))
384 return False ;
385 /* Minibuffer �� mode-line-format �� nil �ˤ��Ƥ�����*/
386 lispMachine_InsertBuffer (pLM, pEntMinibuf) ;
387 lispMgr_CreateNil (pLispMgr, &pEntNil) ;
388 pEntModeline = lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_MODE_LINE_FORMAT) ;
389 lispBuffer_MakeSymbolValue (pLispMgr, pEntMinibuf, pEntModeline) ;
390 lispBuffer_SetSymbolValue (pLispMgr, pEntMinibuf, pEntModeline, pEntNil) ;
391 *ppEntMinibuf = pEntMinibuf ;
392 return True ;
393 }
394
395 Boolean
tLispClient_createFrame(register TLispMachine * pLM,register Widget wgFrame,register Widget wgMinibufFrame,register TLispEntity * pEntBuffer,register TLispEntity * pEntMinibuf)396 tLispClient_createFrame (
397 register TLispMachine* pLM,
398 register Widget wgFrame,
399 register Widget wgMinibufFrame,
400 register TLispEntity* pEntBuffer,
401 register TLispEntity* pEntMinibuf)
402 {
403 register TLispManager* pLispMgr ;
404 TLispEntity* pEntFrame ;
405 TLispEntity* pEntWindow ;
406 TLispEntity* pEntMinibufFrame ;
407 TLispEntity* pEntMinibufWindow ;
408
409 assert (pLM != NULL) ;
410 pLispMgr = pLM->m_pLispMgr ;
411 assert (wgFrame != NULL) ;
412 assert (pEntBuffer != NULL) ;
413 assert (pEntMinibuf != NULL) ;
414
415 /* Minibuffer �Ѥ� frame ���̤��Ѱդ���Ƥ���ʤ顢������ frame ��
416 * ��롣
417 */
418 if (wgMinibufFrame != NULL) {
419 if (TFAILED (lispMgr_MakeFrame (pLispMgr, wgMinibufFrame, NULL, pEntMinibuf, NULL, &pEntMinibufFrame)))
420 return False ;
421 if (TFAILED (lispFrame_GetTopWindow (pEntMinibufFrame, &pEntMinibufWindow)))
422 return False ;
423 assert (pEntMinibufFrame != NULL) ;
424 assert (pEntMinibufWindow != NULL) ;
425 //lispWindow_SetMinibufWindow (pEntMinibufWindow, True) ;
426 lispMachine_InsertFrame (pLM, pEntMinibufFrame) ;
427 XtVaSetValues (wgMinibufFrame, XtNlispFrameObject, pEntMinibufFrame, NULL) ;
428 } else {
429 pEntMinibufFrame = NULL ;
430 pEntMinibufWindow = NULL ;
431 }
432
433 /* Frame ��������롣*/
434 if (TFAILED (lispMgr_MakeFrame (pLispMgr, wgFrame, pEntBuffer, pEntMinibuf, pEntMinibufWindow, &pEntFrame))) {
435 if (pEntMinibufFrame != NULL)
436 lispMachine_RemoveFrame (pLM, pEntMinibufFrame) ;
437 return False ;
438 }
439 XtVaSetValues (wgFrame, XtNlispFrameObject, pEntFrame, NULL) ;
440
441 lispMachine_InsertFrame (pLM, pEntFrame) ;
442 lispMachineCode_SetCurrentFrame (pLM, pEntFrame) ;
443 lispFrame_GetTopWindow (pEntFrame, &pEntWindow) ;
444 lispMachineCode_SetCurrentWindow (pLM, pEntWindow) ;
445 return True ;
446 }
447
448 void
tLispClient_postInitialize(register TLispClient * pClient)449 tLispClient_postInitialize (
450 register TLispClient* pClient)
451 {
452 static const char* apGlobalSymbols [] = {
453 "unread-command-events",
454 "this-command",
455 "last-command",
456 "last-command-event",
457 "unread-command-events",
458 } ;
459 static const char sstrSkkStart [] = "(load \"skk-startup.el\")" ;
460 register TLispMachine* pLM ;
461 register TLispManager* pLispMgr ;
462 register const char** ppString ;
463 register int nString ;
464 TLispEntity* pEntNil ;
465 register TLispEntity* pEntTarget ;
466 register int i ;
467
468 pLM = pClient->m_pLM ;
469 pLispMgr = pLM->m_pLispMgr ;
470 lispMgr_CreateNil (pLispMgr, &pEntNil) ;
471
472 /* Machine ������� VARIABLE ��������롣*/
473 ppString = apGlobalSymbols ;
474 for (i = 0 ; i < NELEMENTS (apGlobalSymbols) ; i ++) {
475 nString = strlen (*ppString) ;
476 lispMachine_SetCurrentSymbolValueWithNameA (pLM, *ppString, nString, pEntNil) ;
477 ppString ++ ;
478 }
479
480 pEntTarget = lispMgr_ParseStringA (pLispMgr, sstrSkkStart, NELEMENTS (sstrSkkStart) - 1, NULL) ;
481 TLispMachine_Test (pLM, pEntTarget) ;
482
483 pClient->m_pLM->m_pState = &lispMachineState_WindowProc ;
484 pClient->m_fModify = True ; /* ����ͤ� True */
485 return ;
486 }
487
488 void
tLispClient_register(register TLispClient * pClient)489 tLispClient_register (
490 register TLispClient* pClient)
491 {
492 assert (pClient != NULL) ;
493
494 pClient->m_pNext = slstLispClient ;
495 slstLispClient = pClient ;
496 return ;
497 }
498
499 void
tLispClient_unregister(register TLispClient * pClient)500 tLispClient_unregister (
501 register TLispClient* pClient)
502 {
503 register TLispClient* pPrevNode ;
504 register TLispClient* pNode ;
505
506 assert (pClient != NULL) ;
507 pNode = slstLispClient ;
508 pPrevNode = NULL ;
509 while (pNode != NULL) {
510 if (pNode == pClient) {
511 if (pPrevNode != NULL) {
512 pPrevNode->m_pNext = pNode->m_pNext ;
513 } else {
514 slstLispClient = pNode->m_pNext ;
515 }
516 return ;
517 }
518 pPrevNode = pNode ;
519 pNode = pNode->m_pNext ;
520 }
521 return ;
522 }
523
524 Boolean
tLispClient_tickAll(void)525 tLispClient_tickAll (void)
526 {
527 register Boolean fBlock, fRetval ;
528 register TLispClient* pNode ;
529
530 fBlock = True ;
531 pNode = slstLispClient ;
532 while (pNode != NULL) {
533 fRetval = TLispClient_Tick (pNode) ;
534 fBlock &= fRetval ;
535 pNode = pNode->m_pNext ;
536 }
537 return fBlock ;
538 }
539
540 /* �द�������ξ�����ή�ˤҤäѤꤢ���ʤ��Ȥޤ����ʤ���
541 */
542 void
tLispClient_updateParent(register TLispMachine * pLM)543 tLispClient_updateParent (
544 register TLispMachine* pLM)
545 {
546 register TLispMachine* pTopLM ;
547 register TLispManager* pLispMgr ;
548 register const char* pString ;
549 register int nString ;
550 register int i ;
551 TLispEntity* pEntTarget ;
552 TLispEntity* pEntSrc ;
553 TLispEntity* pEntDest ;
554 TLispEntity* pEntNewValue ;
555
556 /* ɬ�פʤΤϼ������ơ�
557 * j-count-touroku -> �û�
558 * j-count-kakutei -> �û�
559 * j-jisyo-buffer-modified -> ñ�㥳�ԡ�
560 * ������˻��äƹԤ��ʤ��Ȥ����ʤ���
561 */
562 static struct {
563 const char* m_pName ;
564 int m_nName ;
565 Boolean m_fPlus ;
566 } rUpdateEntity [] = {
567 { "j-count-touroku", 0, True, },
568 { "j-count-kakutei", 0, True, },
569 { "j-jisyo-buffer-modified", 0, False, },
570 } ;
571
572 assert (pLM != NULL) ;
573 pTopLM = pLM->m_pMacParent ;
574 if (pTopLM == NULL)
575 return ;
576 pLispMgr = pLM->m_pLispMgr ;
577 assert (pLispMgr != NULL) ;
578
579 for (i = 0 ; i < NELEMENTS (rUpdateEntity) ; i ++) {
580 pString = rUpdateEntity [i].m_pName ;
581 assert (pString != NULL) ;
582 if (rUpdateEntity [i].m_nName <= 0) {
583 nString = rUpdateEntity [i].m_nName = strlen (pString) ;
584 } else {
585 nString = rUpdateEntity [i].m_nName ;
586 }
587 if (TFAILED (lispMgr_InternSymbolA (pLispMgr, pString, nString, &pEntTarget)))
588 continue ;
589 lispEntity_AddRef (pLispMgr, pEntTarget) ;
590
591 if (TFAILED (lispMachine_GetCurrentSymbolValue (pLM, pEntTarget, &pEntSrc)))
592 goto skip ;
593 if (rUpdateEntity [i].m_fPlus) {
594 long lDest, lSrc ;
595
596 if (TFAILED (lispMachine_GetCurrentSymbolValue (pTopLM, pEntTarget, &pEntDest)) ||
597 TFAILED (lispEntity_GetIntegerValue (pLispMgr, pEntDest, &lDest)))
598 lDest = 0 ;
599 if (TFAILED (lispEntity_GetIntegerValue (pLispMgr, pEntSrc, &lSrc)) || lSrc == 0)
600 goto skip ;
601 lDest += lSrc ;
602 if (TFAILED (lispMgr_CreateInteger (pLispMgr, lDest, &pEntNewValue)))
603 break ;
604 } else {
605 pEntNewValue = pEntSrc ;
606 }
607 lispMachine_SetCurrentSymbolValue (pTopLM, pEntTarget, pEntNewValue) ;
608 skip:
609 lispEntity_Release (pLispMgr, pEntTarget) ;
610 }
611 return ;
612 }
613
614 Boolean
tLispClient_parseAndEval(register TLispMachine * pLM,register const char * pFormat,...)615 tLispClient_parseAndEval (
616 register TLispMachine* pLM,
617 register const char* pFormat,
618 ...)
619 {
620 register TLispManager* pLispMgr ;
621 register TLispEntity* pEntTarget ;
622 char strBuffer [512] ;
623 va_list ap ;
624
625 assert (pLM != NULL) ;
626 assert (pFormat != NULL) ;
627 pLispMgr = pLM->m_pLispMgr ;
628 assert (pLispMgr != NULL) ;
629
630 va_start (ap, pFormat) ;
631 vsnprintf (strBuffer, NELEMENTS (strBuffer) - 1, pFormat, ap) ;
632 va_end (ap) ;
633 strBuffer [NELEMENTS (strBuffer) - 1] = '\0' ;
634 #if defined (DEBUG) || 0
635 fprintf (stderr, "%s\n", strBuffer) ;
636 #endif
637
638 pEntTarget = lispMgr_ParseStringA (pLispMgr, strBuffer, strlen (strBuffer), NULL) ;
639 if (pEntTarget == NULL)
640 return False ;
641 TLispMachine_Test (pLM, pEntTarget) ;
642 lispMgr_CollectGarbage (pLispMgr) ;
643 return True ;
644 }
645
646 #if defined (USE_BLOCKHOOK)
647
648 Boolean
tLispClient_workHook(register XtPointer client_data)649 tLispClient_workHook (
650 register XtPointer client_data)
651 {
652 #if defined (debug) || 0
653 fprintf (stderr, "Garbage collecting ... %d\n", snNeedToRunGC) ;
654 #endif
655 lispMgr_CollectGarbage ((TLispManager *)client_data) ;
656 snNeedToRunGC -- ;
657 if (snNeedToRunGC <= 0) {
658 sfRunGC = 0 ;
659 return True ;
660 }
661 return False ;
662 }
663
664 #endif
665
666