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