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 "local.h"
22 #include <stdio.h>
23 #include <assert.h>
24 #include <X11/Xlib.h>
25 #include <X11/keysym.h>
26 #include "lmachinep.h"
27 #include "cstring.h"
28 
29 static	Boolean		lispMachine_initialize		(TLispMachine*) ;
30 static	Boolean		lispMachine_onKeyPress		(TLispMachine*, void*, void*) ;
31 static	Boolean		lispMachine_onFrameResize	(TLispMachine*, void*, void*) ;
32 static	Boolean		lispMachine_keyEvent2lispEntity	(TLispMachine*, void*, TLispEntity**) ;
33 static	void		lispMachine_quitFlagToSignal	(TLispMachine*) ;
34 
35 static inline	void
lispMachine_quitFlagToSignal(register TLispMachine * pLM)36 lispMachine_quitFlagToSignal (
37 	register TLispMachine*	pLM)
38 {
39 	register TLispManager*		pLispMgr	= pLM->m_pLispMgr ;
40 	register TLispEntity*		pEntQuitFlag ;
41 	register TLispEntity*		pEntInhibitQuit ;
42 	register TLispEntity*		pEntQuit ;
43 	register TLispEntity*		pEntT ;
44 	register TLispEntity*		pEntNil ;
45 	TLispEntity*	pEntValIQ ;
46 	TLispEntity*	pEntValQF ;
47 
48 	/*	quit-flag �� nil �ʤ鲿�⤷�ʤ���*/
49 	pEntQuitFlag	= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_QUIT_FLAG) ;
50 	if (TFAILED (lispMachine_GetCurrentSymbolValue (pLM, pEntQuitFlag,    &pEntValQF)) ||
51 		TSUCCEEDED (lispEntity_Nullp (pLispMgr, pEntValQF)))
52 		return ;
53 
54 	/*	inhibit-quit �� non-nil �ʤ鲿�⤷�ʤ���*/
55 	pEntInhibitQuit	= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_INHIBIT_QUIT) ;
56 	if (TFAILED (lispMachine_GetCurrentSymbolValue (pLM, pEntInhibitQuit, &pEntValIQ)) ||
57 		TFAILED (lispEntity_Nullp (pLispMgr, pEntValIQ)))
58 		return ;
59 
60 	/*	(signal 'quit nil) ��¹Ԥ��롣*/
61 	pEntQuit		= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_QUIT) ;
62 	pEntT			= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_T) ;
63 	pEntNil			= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_NIL) ;
64 	lispMachineCode_SetSignal (pLM, pEntQuit, pEntT) ;
65 	lispMachine_SetCurrentSymbolValue (pLM, pEntQuitFlag,    pEntNil) ;
66 	lispMachine_SetCurrentSymbolValue (pLM, pEntInhibitQuit, pEntNil) ;
67 	return ;
68 }
69 
70 
71 /*
72  *	�����������
73  */
74 Boolean
TLispMachine_Create(register TLispManager * pLispMgr,register TLispMachine * pMacParent,register TLispMachine ** const ppLM)75 TLispMachine_Create (
76 	register TLispManager*	pLispMgr,
77 	register TLispMachine*	pMacParent,
78 	register TLispMachine** const ppLM)
79 {
80 	register TLispMachine*	pLM ;
81 	register int			i ;
82 
83 	assert (pLispMgr != NULL) ;
84 	assert (ppLM != NULL) ;
85 
86 	pLM	= MALLOC (sizeof (TLispMachine)) ;
87 	if (pLM == NULL)
88 		return	False ;
89 
90 	pLM->m_pLispMgr				= pLispMgr ;
91 	pLM->m_pTarget				= NULL ;
92 	pLM->m_pEntException		= NULL ;
93 	pLM->m_pEntExceptionValue	= NULL ;
94 	pLM->m_pEntSignal			= NULL ;
95 	pLM->m_pEntSignalValue		= NULL ;
96 	pLM->m_uStatusFlag			= 0 ;
97 	if (TFAILED (Vstack_Initialize (&pLM->m_vstLispObj,    sizeof (TLispEntity *))) ||
98 		TFAILED (Vstack_Initialize (&pLM->m_vstNonLispObj, sizeof (TNotLispValue))) ||
99 		TFAILED (TVarbuffer_Initialize (&pLM->m_vbufCmdEvents, sizeof (Char)))) {
100 		FREE (pLM) ;
101 		return	False ;
102 	}
103 	for (i = 0 ; i < MAX_LISPOBJ_REGS ; i ++)
104 		pLM->m_apLREGS [i]	= NULL ;
105 	for (i = 0 ; i < MAX_NONLISPOBJ_REGS ; i ++)
106 		pLM->m_alVREGS [i].m_lValue	= 0 ;
107 	for (i = 0 ; i < NELEMENTS (pLM->m_apVariableTable) ; i ++)
108 		pLM->m_apVariableTable [i]	= NULL ;
109  	for (i = 0 ; i < NELEMENTS (pLM->m_apSymbol2SymbolTable) ; i ++)
110  		pLM->m_apSymbol2SymbolTable [i]	= NULL ;
111 	for (i = 0 ; i < NELEMENTS (pLM->m_apFunctionTable) ; i ++)
112 		pLM->m_apFunctionTable [i]	= NULL ;
113 	for (i = 0 ; i < NELEMENTS (pLM->m_apPropertyTable) ; i ++)
114 		pLM->m_apPropertyTable [i]	= NULL ;
115 	pLM->m_pState		= NULL ;
116 	pLM->m_lstBuffer	= NULL ;
117 	pLM->m_lstFrame		= NULL ;
118 	pLM->m_pCurBuffer	= NULL ;
119 	pLM->m_pCurWindow	= NULL ;
120 	pLM->m_pCurFrame	= NULL ;
121 	pLM->m_pEntRegMatch	= NULL ;
122 	pLM->m_fInteractive	= False ;
123 	pLM->m_pMacParent	= pMacParent ;
124 	*ppLM				= pLM ;
125 	lispMachineCode_ResetSignal    (pLM) ;
126 	lispMachineCode_ResetException (pLM) ;
127 	lispMachineCode_ClearQuitFlag  (pLM) ;
128  	lispMachine_initialize (pLM) ;
129 	return	True ;
130 }
131 
132 Boolean
TLispMachine_Destroy(register TLispMachine * pLM)133 TLispMachine_Destroy (
134 	register TLispMachine*	pLM)
135 {
136 	register TLispManager*	pLispMgr ;
137 	register TLispEntity*	pEntity ;
138 	register int			i ;
139 	static int				srEntityOffsets []	= {
140 		offsetof (TLispMachine, m_pEntRegMatch),
141 		offsetof (TLispMachine, m_pEntSignal),
142 		offsetof (TLispMachine, m_pEntSignalValue),
143 		offsetof (TLispMachine, m_pEntException),
144 		offsetof (TLispMachine, m_pEntExceptionValue),
145 	} ;
146 
147 	assert (pLM != NULL) ;
148 
149 	pLispMgr		= pLM->m_pLispMgr ;
150 	assert (pLispMgr != NULL) ;
151 	for (i = 0 ; i < MAX_LISPOBJ_REGS ; i ++) {
152 		if (pLM->m_apLREGS [i] != NULL) {
153 			lispEntity_Release (pLispMgr, pLM->m_apLREGS [i]) ;
154 			pLM->m_apLREGS [i]	= NULL ;
155 		}
156 	}
157 	for (i = 0 ; i < NELEMENTS (srEntityOffsets) ; i ++) {
158 		register TLispEntity**	ppEntity ;
159 		ppEntity	= (TLispEntity **)((unsigned char*)pLM + srEntityOffsets [i]) ;
160 		if (*ppEntity != NULL) {
161 			lispEntity_Release (pLispMgr, *ppEntity) ;
162 			*ppEntity	= NULL ;
163 		}
164 	}
165 	if (pLM->m_lstBuffer != NULL) {
166 		register Boolean	fExit	= False ;
167 		TLispEntity*		pNextBuffer	;
168 
169 		pEntity	= pLM->m_lstBuffer ;
170 		do {
171 			lispBuffer_GetNext (pEntity, &pNextBuffer) ;
172 			if (pEntity == pNextBuffer)
173 				fExit	= True ;
174 #if defined (DEBUG) || 0
175 			fprintf (stderr, "RemoveBuffer: ") ;
176 			lispEntity_Print (pLispMgr, pEntity) ;
177 			fprintf (stderr, "\n") ;
178 #endif
179 			lispMachine_RemoveBuffer (pLM, pEntity) ;
180 			pEntity	= pNextBuffer ;
181 		}	while (!fExit) ;
182 
183 		pLM->m_lstBuffer	= NULL ;
184 	}
185 	if (pLM->m_lstFrame != NULL) {
186 		TLispEntity*	pNextFrame	= pLM->m_lstFrame ;
187 		do {
188 			pEntity	= pNextFrame ;
189 			lispFrame_GetNext (pEntity, &pNextFrame) ;
190 			lispMachine_RemoveFrame (pLM, pEntity) ;
191 		}	while (pEntity != pNextFrame) ;
192 
193 		pLM->m_lstFrame	= NULL ;
194 	}
195 
196 	/*	Mutex ���äƤ����ǽ��������Τǡ����ξ��ˤ� Mutex �� owner
197 	 *	�Ǥʤ��ʤ롣����������*/
198 	lispMgr_AbondonMutex (pLispMgr, pLM) ;
199 
200 	lispBindTable_Destroy (pLispMgr, pLM->m_apVariableTable,      SIZE_LISP_BIND_TABLE) ;
201 	lispBindTable_Destroy (pLispMgr, pLM->m_apSymbol2SymbolTable, SIZE_LISP_BIND_TABLE) ;
202 	lispBindTable_Destroy (pLispMgr, pLM->m_apFunctionTable,      SIZE_LISP_BIND_TABLE) ;
203 	lispBindTable_Destroy (pLispMgr, pLM->m_apPropertyTable,      SIZE_LISP_BIND_TABLE) ;
204 	Vstack_Uninitialize (&pLM->m_vstLispObj) ;
205 	Vstack_Uninitialize (&pLM->m_vstNonLispObj) ;
206 	TVarbuffer_Uninitialize (&pLM->m_vbufCmdEvents) ;
207 	FREE (pLM) ;
208 	return	True ;
209 }
210 
211 TLMRESULT
TLispMachine_Test(register TLispMachine * pLM,register TLispEntity * pTarget)212 TLispMachine_Test (
213 	register TLispMachine*	pLM,
214 	register TLispEntity*	pTarget)
215 {
216 	register TLMRESULT	(*pState)(TLispMachine*) ;
217 	register TLMRESULT	res ;
218 
219 	pState				= pLM->m_pState ;
220 	pLM->m_uStatusFlag	= 0 ;
221 	lispMachineCode_Evaln (pLM, pTarget, &lispMachineState_Done) ;
222 	do {
223 		res	= lispMachine_ExecuteLoop (pLM) ;
224 	}	while (res == LMR_TICK) ;
225 #if defined (DEBUG) || defined (DEBUG_CONSOLE)
226 	if (res == LMR_DONE) {
227 		TLispEntity*	pValue ;
228 
229 		if (LISPMACHINE_SIGNALP (pLM)) {
230 			fprintf (stderr, "signal\n") ;
231 		} else {
232 			fprintf (stderr, "result = ") ;
233 			lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pValue) ;
234 			lispEntity_Print (pLM->m_pLispMgr, pValue) ;
235 			fprintf (stderr, "\n") ;
236 		}
237 	}
238 #endif
239 	assert (res == LMR_DONE) ;
240 	pLM->m_pState		= pState ;
241 	return	res ;
242 }
243 
244 /*
245  *	Lisp Machine ���Ф��볰����������ϡ�
246  *---
247  *	�������Ǥ� X Event �����ꤷ�Ƥ��롣¾�˲�������Τ��⤷��ʤ�
248  *	����
249  */
250 Boolean
TLispMachine_EventProc(register TLispMachine * pLM,register int nEvent,register void * pLPARAM,register void * pRPARAM)251 TLispMachine_EventProc (
252 	register TLispMachine*	pLM,
253 	register int			nEvent,
254 	register void*			pLPARAM,
255 	register void*			pRPARAM)
256 {
257 	static Boolean	(*srEventHandler [])(TLispMachine*, void*, void*)	= {
258 		lispMachine_onKeyPress,
259 		lispMachine_onFrameResize,
260 	} ;
261 	if (nEvent < 0 || nEvent >= sizeof (srEventHandler) / sizeof (srEventHandler [0]))
262 		return	False ;
263 	return	(srEventHandler [nEvent])(pLM, pLPARAM, pRPARAM) ;
264 }
265 
266 TLispManager*
TLispMachine_GetLispManager(register TLispMachine * pLM)267 TLispMachine_GetLispManager (
268 	register TLispMachine*	pLM)
269 {
270 	assert (pLM != NULL) ;
271 	return	pLM->m_pLispMgr ;
272 }
273 
274 #define	MAX_TICK	(6000)
275 
276 /*
277  */
278 TLMRESULT
lispMachine_ExecuteLoop(register TLispMachine * pLM)279 lispMachine_ExecuteLoop (
280 	register TLispMachine*	pLM)
281 {
282 	register int		nCount	= MAX_TICK ;
283 	register TLMRESULT	res ;
284 
285 	assert (pLM != NULL) ;
286 	assert (pLM->m_pLispMgr != NULL) ;
287 	assert (pLM->m_pState   != NULL) ;
288 
289 	while (nCount -- > 0) {
290 		res	= (pLM->m_pState) (pLM) ;
291 		switch (res) {
292 		case	LMR_RETURN:
293 			lispMachineCode_PopState (pLM) ;
294 			/*	fall-down */
295 		case	LMR_CONTINUE:
296 			break ;
297 		case	LMR_TICK:
298 			nCount	= 0 ;
299 			break ;
300 		case	LMR_SUSPEND:
301 		case	LMR_ERROR:
302 		case	LMR_DONE:
303 		default:
304 			return	res ;
305 		}
306 		lispMachine_quitFlagToSignal (pLM) ;
307 	}
308 	return	LMR_TICK ;
309 }
310 
311 Boolean
lispMachine_CheckArgument(register TLispMachine * pLM,register TLispEntity * pArglist,register LMCMDINFO const * pProcInfo,register int * pnArg)312 lispMachine_CheckArgument (
313 	register TLispMachine*		pLM,
314 	register TLispEntity*		pArglist,
315 	register LMCMDINFO const *	pProcInfo,
316 	register int*				pnArg)
317 {
318 	register Boolean	fRetval ;
319 	int		nArg ;
320 
321 	if (TFAILED (lispEntity_CountArgument (pLM->m_pLispMgr, pArglist, &nArg)))
322 		return	False ;
323 	switch (pProcInfo->m_iArgtype) {
324 		/*	��¡����¤����꤬�����硣*/
325 	case	LISPCMD_ARGTYPE_NORMAL:
326 		fRetval	= (pProcInfo->m_nMinArgNum <= nArg &&
327 				   nArg <= pProcInfo->m_nMaxArgNum)? True : False ;
328 		break ;
329 
330 		/*	���¤������硣*/
331 	case	LISPCMD_ARGTYPE_LOWER:
332 		fRetval	= (0 <= nArg && pProcInfo->m_nMinArgNum <= nArg)? True : False ;
333 		break ;
334 
335 		/*	��¤������硣*/
336 	case	LISPCMD_ARGTYPE_UPPER:
337 		fRetval	= (0 <= nArg && nArg <= pProcInfo->m_nMaxArgNum)? True : False ;
338 		break ;
339 
340 		/*	�ä����¤����ʤ���硣*/
341 	case	LISPCMD_ARGTYPE_NOBOUND:
342 	case	LISPCMD_ARGTYPE_CDR:
343 		fRetval	= (nArg >= 0)? True : False ;
344 		break ;
345 
346 	case	LISPCMD_ARGTYPE_SPECIAL:
347 	case	LISPCMD_ARGTYPE_LAMBDA:
348 	case	LISPCMD_ARGTYPE_MACRO:
349 		fRetval	= True ;
350 		break ;
351 
352 	default:
353 		fRetval	= False ;
354 		break ;
355 	}
356 	if (pnArg != NULL)
357 		*pnArg	= nArg ;
358 
359 	return	fRetval ;
360 }
361 
362 /*
363  *	Buffer �� lispmachine �δ��������ɲä��롣Buffer �ϻ��Ȥ��Ƥ��� SYMBOL
364  *	���ʤ��Ƥ⾡��� GC �ˤ�äƾä����ꤷ�ʤ����Ĥޤ�ϡ��ȼ��˻��Ȥ����
365  *	����櫓�ǡġ�
366  */
367 Boolean
lispMachine_InsertBuffer(register TLispMachine * pLM,register TLispEntity * pEntBuffer)368 lispMachine_InsertBuffer (
369 	register TLispMachine*	pLM,
370 	register TLispEntity*	pEntBuffer)
371 {
372 	assert (pLM != NULL) ;
373 	assert (pEntBuffer != NULL) ;
374 	assert (pEntBuffer->m_iType == LISPENTITY_BUFFER) ;
375 
376 	if (pLM->m_lstBuffer == NULL) {
377 		pLM->m_lstBuffer	= pEntBuffer ;
378 		lispBuffer_SetPrevious (pEntBuffer, pEntBuffer) ;
379 		lispBuffer_SetNext     (pEntBuffer, pEntBuffer) ;
380 	} else {
381 		TLispEntity*	pPrevBuffer ;
382 
383 		lispBuffer_GetPrevious (pLM->m_lstBuffer,	&pPrevBuffer) ;
384 		assert (pPrevBuffer != NULL) ;
385 		lispBuffer_SetPrevious (pEntBuffer,			pPrevBuffer) ;
386 		lispBuffer_SetNext     (pEntBuffer,			pLM->m_lstBuffer) ;
387 		lispBuffer_SetPrevious (pLM->m_lstBuffer,	pEntBuffer) ;
388 		lispBuffer_SetNext     (pPrevBuffer,		pEntBuffer) ;
389 	}
390 	lispEntity_AddRef (pLM->m_pLispMgr, pEntBuffer) ;
391 	return	True ;
392 }
393 
394 Boolean
lispMachine_RemoveBuffer(register TLispMachine * pLM,register TLispEntity * pEntBuffer)395 lispMachine_RemoveBuffer (
396 	register TLispMachine*	pLM,
397 	register TLispEntity*	pEntBuffer)
398 {
399 	TLispEntity*	pPrevBuffer ;
400 	TLispEntity*	pNextBuffer ;
401 	assert (pLM != NULL) ;
402 	assert (pLM->m_lstBuffer != NULL) ;
403 	assert (pEntBuffer != NULL) ;
404 	assert (pEntBuffer->m_iType == LISPENTITY_BUFFER) ;
405 
406 #if defined (DEBUG_LV99)
407 	if (pLM->m_lstBuffer != NULL) {
408 		TLispEntity*	pNode	= pLM->m_lstBuffer ;
409 		do {
410 			if (pNode == pEntBuffer)
411 				break ;
412 			lispBuffer_GetNext (pNode, &pNode) ;
413 		}	while (pNode != pLM->m_lstBuffer) ;
414 
415 		assert (pNode == pEntBuffer) ;
416 	}
417 #endif
418 	lispBuffer_GetPrevious (pEntBuffer, &pPrevBuffer) ;
419 	assert (pPrevBuffer != NULL) ;
420 	lispBuffer_GetNext     (pEntBuffer, &pNextBuffer) ;
421 	assert (pNextBuffer != NULL) ;
422 	if (pPrevBuffer == pEntBuffer && pNextBuffer == pEntBuffer) {
423 		assert (pLM->m_lstBuffer == pEntBuffer) ;
424 		pLM->m_lstBuffer	= NULL ;
425 	} else {
426 		lispBuffer_SetNext     (pPrevBuffer, pNextBuffer) ;
427 		lispBuffer_SetPrevious (pNextBuffer, pPrevBuffer) ;
428 		if (pLM->m_lstBuffer == pEntBuffer)
429 			pLM->m_lstBuffer	= pNextBuffer ;
430 	}
431 	lispEntity_Release (pLM->m_pLispMgr, pEntBuffer) ;
432 	return	True ;
433 }
434 
435 /*
436  *	Frame �� lispmachine �δ��������ɲä��롣Buffer ��Ʊ�������������٤�
437  *	¸�ߡ�
438  */
439 Boolean
lispMachine_InsertFrame(register TLispMachine * pLM,register TLispEntity * pEntFrame)440 lispMachine_InsertFrame (
441 	register TLispMachine*	pLM,
442 	register TLispEntity*	pEntFrame)
443 {
444 	assert (pLM != NULL) ;
445 	assert (pEntFrame != NULL) ;
446 	assert (pEntFrame->m_iType == LISPENTITY_FRAME) ;
447 
448 	if (pLM->m_lstFrame == NULL) {
449 		pLM->m_lstFrame		= pEntFrame ;
450 		lispFrame_SetPrevious (pEntFrame, pEntFrame) ;
451 		lispFrame_SetNext     (pEntFrame, pEntFrame) ;
452 	} else {
453 		TLispEntity*	pPrevFrame ;
454 
455 		lispFrame_GetPrevious (pLM->m_lstFrame, &pPrevFrame) ;
456 		assert (pPrevFrame != NULL) ;
457 		lispFrame_SetPrevious (pEntFrame,    pPrevFrame) ;
458 		lispFrame_SetNext     (pEntFrame,    pLM->m_lstFrame) ;
459 		lispFrame_SetPrevious (pLM->m_lstFrame, pEntFrame) ;
460 		lispFrame_SetNext     (pPrevFrame,      pEntFrame) ;
461 	}
462 	lispEntity_AddRef (pLM->m_pLispMgr, pEntFrame) ;
463 	return	True ;
464 }
465 
466 Boolean
lispMachine_RemoveFrame(register TLispMachine * pLM,register TLispEntity * pEntFrame)467 lispMachine_RemoveFrame (
468 	register TLispMachine*	pLM,
469 	register TLispEntity*	pEntFrame)
470 {
471 	TLispEntity*	pPrevFrame ;
472 	TLispEntity*	pNextFrame ;
473 	assert (pLM != NULL) ;
474 	assert (pLM->m_lstFrame != NULL) ;
475 	assert (pEntFrame != NULL) ;
476 	assert (pEntFrame->m_iType == LISPENTITY_FRAME) ;
477 
478 #if defined (DEBUG_LV99)
479 	if (pLM->m_lstFrame != NULL) {
480 		TLispEntity*	pNode	= pLM->m_lstFrame ;
481 		do {
482 			if (pNode == pEntFrame)
483 				break ;
484 			lispFrame_GetNext (pNode, &pNode) ;
485 		}	while (pNode != pLM->m_lstFrame) ;
486 
487 		assert (pNode == pEntFrame) ;
488 	}
489 #endif
490 	lispFrame_GetPrevious (pEntFrame, &pPrevFrame) ;
491 	assert (pPrevFrame != NULL) ;
492 	lispFrame_GetNext     (pEntFrame, &pNextFrame) ;
493 	assert (pNextFrame != NULL) ;
494 	if (pPrevFrame == pEntFrame && pNextFrame == pEntFrame) {
495 		assert (pLM->m_lstFrame == pEntFrame) ;
496 		pLM->m_lstFrame	= NULL ;
497 	} else {
498 		lispFrame_SetNext     (pPrevFrame, pNextFrame) ;
499 		lispFrame_SetPrevious (pNextFrame, pPrevFrame) ;
500 		if (pLM->m_lstFrame == pEntFrame)
501 			pLM->m_lstFrame	= pNextFrame ;
502 	}
503 	lispEntity_Release (pLM->m_pLispMgr, pEntFrame) ;
504 	return	True ;
505 }
506 
507 Boolean
lispMachine_ActivateAllFrame(register TLispMachine * pLM,register Boolean fActivate)508 lispMachine_ActivateAllFrame (
509 	register TLispMachine*	pLM,
510 	register Boolean		fActivate)
511 {
512 	register TLispManager*	pLispMgr ;
513 	TLispEntity*	pEntFrame ;
514 
515 	assert (pLM != NULL) ;
516 	pLispMgr	= pLM->m_pLispMgr ;
517 	assert (pLispMgr != NULL) ;
518 
519 	if (pLM->m_lstFrame == NULL)
520 		return	True ;
521 
522 	pEntFrame	= pLM->m_lstFrame ;
523 	do {
524 		lispFrame_Activate (pLispMgr, pEntFrame, fActivate) ;
525 		lispFrame_GetNext (pEntFrame, &pEntFrame) ;
526 	}	while (pEntFrame != pLM->m_lstFrame) ;
527 
528 	return	True ;
529 }
530 
531 Boolean
lispMachine_QueueInEvent(register TLispMachine * pLM,register TLispEntity * pEntQueue,register TLispEntity * pEntEvent)532 lispMachine_QueueInEvent (
533 	register TLispMachine*	pLM,
534 	register TLispEntity*	pEntQueue,
535 	register TLispEntity*	pEntEvent)
536 {
537 	register TLispManager*	pLispMgr	= pLM->m_pLispMgr ;
538 	TLispEntity*	pEntNil ;
539 	TLispEntity*	pEntLstEvent ;
540 	TLispEntity*	pEntQueueValue ;
541 	Boolean			fRetval ;
542 
543 	/*	List �ˤĤʤ�����ˡ�Lisp Entity �� List �ˤ��롣*/
544 	lispMgr_CreateNil  (pLispMgr, &pEntNil) ;
545 	lispEntity_AddRef  (pLispMgr, pEntEvent) ;
546 	fRetval	= lispMgr_CreateConscell (pLispMgr, pEntEvent, pEntNil, &pEntLstEvent) ;
547 	lispEntity_Release (pLispMgr, pEntEvent) ;
548 	if (TFAILED (fRetval))
549 		return	False ;
550 
551 	if (TFAILED (lispMachine_GetCurrentSymbolValue (pLM, pEntQueue, &pEntQueueValue)) ||
552 		TSUCCEEDED (lispEntity_Nullp (pLispMgr, pEntQueueValue))) {
553 		lispMachine_SetCurrentSymbolValue (pLM, pEntQueue, pEntLstEvent) ;
554 	} else {
555 		register TLispEntity*	pEntNode	= pEntQueueValue ;
556 		TLispEntity*	pEntNextNode ;
557 
558 		/*	list ����֤ˤ��ɤäƤ���Τ�ĺ���ʤ������ޤ�������ʤ˹�
559 		 *	�����٤ǸƤФ��櫓�ǤϤʤ��Ȼפ���*/
560 		for ( ; ; ) {
561 			if (TFAILED (lispEntity_GetCdr (pLispMgr, pEntNode, &pEntNextNode)))
562 				return	False ;
563 			if (TSUCCEEDED (lispEntity_Nullp (pLispMgr, pEntNextNode))) {
564 				lispEntity_SetCdr (pLispMgr, pEntNode, pEntLstEvent) ;
565 				break ;
566 			}
567 			pEntNode	= pEntNextNode ;
568 		}
569 	}
570 	return	True ;
571 }
572 
573 /*	�Хåե�̾�����Ѥ��ƥХåե��������롣
574  */
575 Boolean
lispMachine_GetBuffer(register TLispMachine * pLM,register const Char * pStrName,register int nStrName,register TLispEntity ** ppEntRetval)576 lispMachine_GetBuffer (
577 	register TLispMachine*	pLM,
578 	register const Char*	pStrName,
579 	register int			nStrName,
580 	register TLispEntity**	ppEntRetval)
581 {
582 	register TLispManager*	pLispMgr	= pLM->m_pLispMgr ;
583 	register TLispEntity*	pEntTopBuffer ;
584 	register TLispEntity*	pEntBuffer ;
585 	TLispEntity*	pEntNextBuffer ;
586 	TLispEntity*	pEntBufName ;
587 	const Char*		pBufName ;
588 	int				nBufName ;
589 
590 	while (pLM != NULL && pLM->m_pCurBuffer != NULL) {
591 		pEntTopBuffer	= pLM->m_pCurBuffer ;
592 		pEntBuffer		= pEntTopBuffer ;
593 		do {
594 			lispBuffer_GetName (pLispMgr, pEntBuffer, &pEntBufName) ;
595 #if defined (DEBUG)
596 			if (pEntBufName != NULL) {
597 				fprintf (stderr, "lispMachine_GetBuffer () => ") ;
598 				lispEntity_Print (pLispMgr, pEntBufName) ;
599 				fprintf (stderr, "\n") ;
600 			}
601 #endif
602 			if (pEntBufName != NULL &&
603 				TSUCCEEDED (lispEntity_GetStringValue (pLispMgr, pEntBufName, &pBufName, &nBufName)) &&
604 				nStrName == nBufName &&
605 				!Cstrncmp (pStrName, pBufName, nStrName)) {
606 				*ppEntRetval	= pEntBuffer ;
607 				return	True ;
608 			}
609 			lispBuffer_GetNext (pEntBuffer, &pEntNextBuffer) ;
610 			pEntBuffer	= pEntNextBuffer ;
611 		}	while (pEntBuffer != pEntTopBuffer) ;
612 
613 		pLM	= pLM->m_pMacParent ;
614 	}
615 
616 	return	False ;
617 }
618 
619 /*	�Хåե��˳�����Ƥ�줿�ե�����̾�����Ѥ��ƥХåե��������롣
620  *(��)
621  *	���˥Хåե��˳�����Ƥ�줿�ե����������¾�ΥХåե��˳�����Ƥ������ܤʤ�
622  *	����������ɤ��Ȥ�Τ������꤬���뤬�ġ�
623  *	���δؿ����Τ� buffer-local-variable �Ǥ���Ȥ����(ɬ�� buffer-local-variable
624  *	�Ȥ���¸�ߤ���) buffer-file-name ���ͤ������Ϳ����줿�ե�����̾����Ӥ��Ƥ�
625  *	������Ǥ��롣
626  */
627 Boolean
lispMachine_GetFileBuffer(register TLispMachine * pLM,register const Char * pFileName,register int nFileName,register TLispEntity ** ppEntRetval)628 lispMachine_GetFileBuffer (
629 	register TLispMachine*	pLM,
630 	register const Char*	pFileName,
631 	register int			nFileName,
632 	register TLispEntity**	ppEntRetval)
633 {
634 	register TLispManager*	pLispMgr	= pLM->m_pLispMgr ;
635 	register TLispEntity*	pEntBufFileName ;
636 	register TLispEntity*	pEntTopBuffer ;
637 	register TLispEntity*	pEntBuffer ;
638 	register Boolean			fRetval ;
639 	TLispEntity*	pEntNextBuffer ;
640 	TLispEntity*	pEntValue ;
641 	const Char*		pBufFileName ;
642 	int				nBufFileName ;
643 
644 	pEntBufFileName	= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_BUFFER_FILE_NAME) ;
645 	while (pLM != NULL && pLM->m_pCurBuffer != NULL) {
646 		pEntTopBuffer	= pLM->m_pCurBuffer ;
647 		pEntBuffer		= pEntTopBuffer ;
648 		do {
649 			fRetval	= lispBuffer_GetSymbolValue (pLispMgr, pEntBuffer, pEntBufFileName, &pEntValue) ;
650 #if defined (DEBUG)
651 			if (TSUCCEEDED (fRetval)) {
652 				lispEntity_Print (pLispMgr, pEntBufFileName) ;
653 				fprintf (stderr, "(%p) = ", pEntBuffer) ;
654 				lispEntity_Print (pLispMgr, pEntValue) ;
655 				fprintf (stderr, "\n") ;
656 			}
657 #endif
658 			if (TSUCCEEDED (fRetval) &&
659 				TSUCCEEDED (lispEntity_GetStringValue (pLispMgr, pEntValue, &pBufFileName, &nBufFileName)) &&
660 				nBufFileName == nFileName &&
661 				!Cstrncmp (pFileName, pBufFileName, nFileName)) {
662 				*ppEntRetval	= pEntBuffer ;
663 				return	True ;
664 			}
665 			lispBuffer_GetNext (pEntBuffer, &pEntNextBuffer) ;
666 			pEntBuffer	= pEntNextBuffer ;
667 		}	while (pEntBuffer != pEntTopBuffer) ;
668 
669 		pLM	= pLM->m_pMacParent ;
670 	}
671 
672 	return	False ;
673 }
674 
675 Boolean
lispMachine_GenerateNewBufferName(register TLispMachine * pLM,register const Char * pStrNAME,register int nStrNAME,register TLispEntity ** ppEntRetval)676 lispMachine_GenerateNewBufferName (
677 	register TLispMachine*	pLM,
678 	register const Char*	pStrNAME,
679 	register int			nStrNAME,
680 	register TLispEntity**	ppEntRetval)
681 {
682 	register TLispManager*	pLispMgr	= pLM->m_pLispMgr ;
683 	TVarbuffer		vbufNAME ;
684 	TLispEntity*	pEntBuffer ;
685 	char			achBuffer [35] ;	/* 35 �� magic-number��Ŭ���ˤĤ�����*/
686 	register Char*	pBufName ;
687 	register char*	pSrc ;
688 	register Char*	pDest ;
689 	register Char*	pModify ;
690 	unsigned int	nNumber ;
691 	register Boolean	fRetval ;
692 
693 	assert (pLM != NULL) ;
694 	assert (pStrNAME != NULL && nStrNAME > 0) ;
695 	assert (ppEntRetval != NULL) ;
696 
697 	if (TFAILED (TVarbuffer_Initialize (&vbufNAME, sizeof (Char))))
698 		return	False ;
699 	if (TFAILED (TVarbuffer_Add (&vbufNAME, pStrNAME, nStrNAME)) ||
700 		TFAILED (TVarbuffer_Require (&vbufNAME, NELEMENTS (achBuffer))))
701 		return	False ;
702 
703 	pBufName	= TVarbuffer_GetBuffer (&vbufNAME) ;
704 	pModify		= pBufName + nStrNAME ;
705 	nNumber		= 2 ;
706 	while (TSUCCEEDED (lispMachine_GetBuffer (pLM, pBufName, nStrNAME, &pEntBuffer)) &&
707 		   nNumber != 0) {
708 		snprintf (achBuffer, NELEMENTS (achBuffer) - 1, "<%d>", nNumber) ;
709 		achBuffer [sizeof (achBuffer) - 1]	= '\0' ;
710 		nNumber		++ ;
711 		pSrc		= achBuffer ;
712 		pDest		= pModify ;
713 		while (*pSrc != '\0')
714 			*pDest ++	= *pSrc ++ ;
715 		nStrNAME	= pDest - pModify ;
716 	}
717 	fRetval	= lispMgr_CreateString (pLispMgr, pBufName, nStrNAME, ppEntRetval) ;
718 	TVarbuffer_Uninitialize (&vbufNAME) ;
719 	return	fRetval ;
720 }
721 
722 Boolean
lispMachine_EnumBuffer(register TLispMachine * pLM,register Boolean fStartCurrentBufferp,register Boolean (* pEnumProc)(TLispMachine *,TLispEntity *,void *,Boolean *),register void * pCaller)723 lispMachine_EnumBuffer (
724 	register TLispMachine*	pLM,
725 	register Boolean		fStartCurrentBufferp,
726 	register Boolean		(*pEnumProc)(TLispMachine*, TLispEntity*, void*, Boolean*),
727 	register void*			pCaller)
728 {
729 	register TLispEntity*	pEntBuffer ;
730 	register TLispEntity*	pEntTop ;
731 
732 	assert (pLM       != NULL) ;
733 	assert (pEnumProc != NULL) ;
734 
735 	pEntBuffer	= (fStartCurrentBufferp)? pLM->m_pCurBuffer : pLM->m_lstBuffer ;
736 	pEntTop		= pEntBuffer ;
737 	if (pEntBuffer != NULL) {
738 		TLispEntity*	pEntNext ;
739 		Boolean			fContinue	= True ;
740 
741 		do {
742 			if (TFAILED ((pEnumProc)(pLM, pEntBuffer, pCaller, &fContinue)))
743 				return	False ;
744 			if (TFAILED (fContinue))
745 				break ;
746 			lispBuffer_GetNext (pEntBuffer, &pEntNext) ;
747 			pEntBuffer	= pEntNext ;
748 		}	while (pEntBuffer != pEntTop) ;
749 	}
750 	return	True ;
751 }
752 
753 /*========================================================================*
754  *	private functions
755  */
756 Boolean
lispMachine_initialize(register TLispMachine * pLM)757 lispMachine_initialize (
758 	register TLispMachine*	pLM)
759 {
760 	register TLispManager*	pLispMgr ;
761 	static struct {
762 		int		m_nSrc ;
763 		int		m_nDest ;
764 	}	srEquivalentSymbols []	= {
765 		{	LISPMGR_INDEX_LAST_COMMAND_EVENT,	LISPMGR_INDEX_LAST_COMMAND_CHAR, },
766 	} ;
767 	register TLispEntity*	pEntSrc ;
768 	register TLispEntity*	pEntDest ;
769 	register int			i ;
770 	register TLispBind**	pBindTable ;
771 	TLispBind*				pBind ;
772 
773 	/*	��̾����Ʊ������ư������ܥ����Ͽ���롣
774 	 */
775 	pLispMgr	= pLM->m_pLispMgr ;
776 	pBindTable	= pLM->m_apSymbol2SymbolTable ;
777 	for (i = 0 ; i < NELEMENTS (srEquivalentSymbols) ; i ++) {
778 		pEntSrc		= lispMgr_GetReservedEntity (pLispMgr, srEquivalentSymbols [i].m_nSrc) ;
779 		pEntDest	= lispMgr_GetReservedEntity (pLispMgr, srEquivalentSymbols [i].m_nDest) ;
780 		if (TFAILED (lispBindTable_MakeEntry (pLispMgr, pBindTable, NELEMENTS (pLM->m_apSymbol2SymbolTable), pEntSrc, &pBind)))
781 			return	False ;
782 		if (TFAILED (lispBind_SetValue (pLispMgr, pBind, pEntDest)))
783 			return	False ;
784 	}
785 	return	True ;
786 }
787 
788 /*	ʸ�������ɤ���꿶���ʤ��ä�����ʸ�������ɤϳ�꿶��줿����ɤ⡢����Ʊ��
789  *	�˲�����Ƥ��륭��(status)��ʸ�������ɤ˱ƶ����ʤ��ä����ˤϡ��ü�ʥ�����
790  *	�ˤ���ɬ�פ����롣
791  */
792 Boolean
lispMachine_onKeyPress(register TLispMachine * pLM,register void * pLPARAM,register void * pRPARAM)793 lispMachine_onKeyPress (
794 	register TLispMachine*	pLM,
795 	register void*			pLPARAM,
796 	register void*			pRPARAM)
797 {
798 	register TLispManager*	pLispMgr ;
799 	register XEvent*		pEvent	= (XEvent *)pLPARAM ;
800 	TLispEntity*	pEntEvent ;
801 	TLispEntity*	pEntQueue ;
802 
803 	assert (pLM     != NULL) ;
804 	assert (pLPARAM != NULL) ;
805 	pLispMgr	= pLM->m_pLispMgr ;
806 	assert (pLispMgr != NULL) ;
807 
808 	if (pEvent->type != KeyPress)
809 		return	True ;
810 
811 	/*	XEvent ����ʸ�������ɤ��Ѵ����롣�����ϵ���Ȥ����� Window System
812 	 *	��¸�ʾ��Ǥ��ꡢlispmachine �����ڤ�Υ���������ä������⤦������
813 	 *	���������ˤʤ�����
814 	 *
815 	 *	Modifier Key �Τߤξ��ˤϼΤƤ롣
816 	 */
817 	if (TFAILED (lispMachine_keyEvent2lispEntity (pLM, pEvent, &pEntEvent)))
818 		return	True ;
819 #if defined (DEBUG)
820 	fprintf (stderr, "key-in: ") ;
821 	lispEntity_Print (pLispMgr, pEntEvent) ;
822 	fprintf (stderr, "\n") ;
823 #endif
824 
825 	/*	������� unread-command-events ���ɲä���Ȥ�����ȡ����������
826 	 *	Event �� Command Loop ����ߤ��ʤ�������...�Ȥ����������롣
827 	 *	�Ǥʤ��� unread-command-events �ν������롣
828 	 */
829 	pEntQueue	= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_UNREAD_COMMAND_EVENTS) ;
830 	return	lispMachine_QueueInEvent (pLM, pEntQueue, pEntEvent) ;
831 }
832 
833 Boolean
lispMachine_onFrameResize(register TLispMachine * pLM,register void * pLPARAM,register void * pRPARAM)834 lispMachine_onFrameResize (
835 	register TLispMachine*	pLM,
836 	register void*			pLPARAM,
837 	register void*			pRPARAM)
838 {
839 	register TLispEntity*		pEntFrame	= (TLispEntity *)pLPARAM ;
840 	register const XRectangle*	pRect		= (const XRectangle *)pRPARAM ;
841 
842 	assert (pLM != NULL) ;
843 	assert (pEntFrame != NULL) ;
844 	return	lispMachine_ResizeFrame (pLM, pEntFrame, pRect) ;
845 }
846 
847 Boolean
lispMachine_keyboardSignal(register TLispMachine * pLM)848 lispMachine_keyboardSignal (
849 	register TLispMachine*	pLM)
850 {
851 	register TLispManager*		pLispMgr ;
852 	register TLispEntity*		pEntQuitFlag ;
853 	register TLispEntity*		pEntInhibitQuit ;
854 	register TLispEntity*		pEntT ;
855 	TLispEntity*	pEntValue ;
856 
857 	assert (pLM != NULL) ;
858 	pLispMgr	= pLM->m_pLispMgr ;
859 	assert (pLispMgr != NULL) ;
860 
861 	/*	command-loop �ˤ�����ˤϡ����⤷�ʤ���
862 	 */
863 	if (pLM->m_pState == &lispMachineState_WindowProc)
864 		return	False ;
865 
866 	pEntInhibitQuit	= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_INHIBIT_QUIT) ;
867 	pEntQuitFlag	= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_QUIT_FLAG) ;
868 	pEntT			= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_T) ;
869 
870 	lispMachine_SetCurrentSymbolValue (pLM, pEntQuitFlag, pEntT) ;
871 	if (TFAILED (lispMachine_GetCurrentSymbolValue (pLM, pEntInhibitQuit, &pEntValue)) ||
872 		TSUCCEEDED (lispEntity_Nullp (pLispMgr, pEntValue))) {
873 		register TLispEntity*	pEntQuit ;
874 		pEntQuit		= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_QUIT) ;
875 		lispMachineCode_SetSignal (pLM, pEntQuit, pEntT) ;
876 	}
877 	return	True ;
878 }
879 
880 Boolean
lispMachine_keyEvent2lispEntity(register TLispMachine * pLM,register void * pvEvent,register TLispEntity ** ppEntRetval)881 lispMachine_keyEvent2lispEntity (
882 	register TLispMachine*	pLM,
883 	register void*			pvEvent,
884 	register TLispEntity**	ppEntRetval)
885 {
886 	register TLispManager*	pLispMgr	= pLM->m_pLispMgr ;
887 	register XEvent*		pXEvent		= (XEvent *)pvEvent ;
888 	register XKeyEvent*		pEvent ;
889 	register Boolean		fRetval ;
890 	TLispEntity*		pEntKeyValue ;
891 	char				aBuf [4] ;
892 	KeySym				keysym ;
893 	Char				cc ;
894 	register int		nKey ;
895 
896 	assert (pXEvent != NULL) ;
897 	pEvent	= &pXEvent->xkey ;
898 
899 	/*	ʸ�������ɤ���꿶���ʤ��ä�����ʸ�������ɤϳ�꿶��줿����ɤ⡢����Ʊ��
900 	 *	�˲�����Ƥ��륭��(status)��ʸ�������ɤ˱ƶ����ʤ��ä����ˤϡ��ü�ʥ�����
901 	 *	�ˤ���ɬ�פ����롣
902 	 */
903 	nKey	= XLookupString (pEvent, aBuf, NELEMENTS (aBuf), &keysym, NULL) ;
904 	if (IsModifierKey (keysym))
905 		return	False ;
906 
907 	if (nKey <= 0) {
908 		char					bufKEY [256] ;
909 		register unsigned int	uState	= pEvent->state ;
910 
911 		/*	ʸ�������ɤ���꿶���ʤ��������ä����ν�����
912 		 *	ľ�� KeySym �� Status ���� Char ��������뤷���ʤ���
913 		 *
914 		 *	�����ǡ�status �� 8bit �� keysym �� 16bit ������Ȥ���������֤���
915 		 *	���롣X11 �� header ����¤�ˤ����Ƥϡ�keysym �� 24bit ��ɬ��
916 		 *	�������ɡġ�
917 		 */
918 		if (TFAILED (keysym2string (bufKEY, NELEMENTS (bufKEY), keysym, uState))) {
919 			cc	= Char_Make (KCHARSET_XKEYSYM, (uState << 16) | keysym) ;
920 		} else {
921 			register int	nKeyStr	= strlen (bufKEY) ;
922 
923 			if (TFAILED (lispMgr_InternSymbolA (pLispMgr, bufKEY, nKeyStr, &pEntKeyValue)))
924 				return	False ;
925 			goto	exit_func ;
926 		}
927 	} else if (pEvent->state != 0) {
928 		/*	state ���⡢caps �����äƤ��Ƥ����ϤʤΤ���control ������
929 		 * �Ƥ����ϤʤΤ�����Ȥ��Х������롣�⤷��forward ���줿������
930 		 *	caps + �����Υ������ü�ʰ�̣�����Ƥ���ȡ��ޤ��Ҥɤ�����
931 		 *	�ˤʤ������
932 		 */
933 		register unsigned int	uState		= 0 ;
934 		register unsigned int	uMask ;
935 		register char			chOrig		= aBuf [0] ;
936 		register int			i ;
937 
938 		/*	signal �����ä��Τʤ顢�����Ϥ����ǽ�λ��*/
939 		if (aBuf [0] == 0x07 && nKey == 1 &&
940 			TSUCCEEDED (lispMachine_keyboardSignal (pLM)))
941 			return	False ;
942 
943 		for (i = ShiftMapIndex ; i <= Mod5MapIndex ; i ++) {
944 			uMask	= 1 << i ;
945 			if (pEvent->state & uMask) {
946 				pEvent->state	&= ~uMask ;
947 				nKey	= XLookupString (pEvent, aBuf, NELEMENTS (aBuf), &keysym, NULL) ;
948 
949 				/*	����Ƥ��ޤ� State ��ȴ���Ф���keysym �ξ������Ȥ��Ƥ�
950 				 *	�ޤ��Τǡ�Ƚ��ˤϻȤ�ʤ���
951 				 */
952 				if (nKey > 0 && aBuf [0] == chOrig)
953 					uState	|= uMask ;
954 				pEvent->state	|= uMask ;
955 			}
956 		}
957 		cc	= Char_Make ((uState != 0)? KCHARSET_XCHAR : KCHARSET_ASCII, (uState << 16) | (unsigned char)chOrig) ;
958 	} else {
959 		cc	= Char_MakeAscii (aBuf [0]) ;
960 	}
961 	if (TFAILED (lispMgr_CreateInteger (pLispMgr, (long)cc, &pEntKeyValue)))
962 		return	False ;
963   exit_func:
964 	lispEntity_AddRef (pLispMgr, pEntKeyValue) ;
965 	fRetval	= lispMgr_CreateXEvent (pLispMgr, pEntKeyValue, pXEvent, ppEntRetval) ;
966 	lispEntity_Release (pLispMgr, pEntKeyValue) ;
967 	return	fRetval ;
968 }
969 
970 Char
lispMachine_lispKeyEventSymbol2Char(register TLispManager * pLispMgr,register TLispEntity * pEntKey)971 lispMachine_lispKeyEventSymbol2Char (
972 	register TLispManager*	pLispMgr,
973 	register TLispEntity*	pEntKey)
974 {
975 	const Char*		pStrSymName ;
976 	int				nStrSymName ;
977 	KeySym			keySym ;
978 	unsigned int	uState ;
979 
980 	if (TFAILED (lispEntity_GetSymbolName (pLispMgr, pEntKey, &pStrSymName, &nStrSymName)))
981 		return	(Char) -1 ;
982 
983 	if (TFAILED (cstring2keysym (pStrSymName, nStrSymName, &keySym, &uState)))
984 		return	(Char) -1 ;
985 
986 	return	Char_Make (KCHARSET_XKEYSYM, (uState << 16) | keySym) ;
987 }
988 
989 /*	for debugging
990  */
991 #if defined (DEBUG)
992 Boolean
lispMachine_ShowRegisterValue(TLispMachine * pLM)993 lispMachine_ShowRegisterValue (TLispMachine* pLM)
994 {
995 	const char*	apName [MAX_LISPOBJ_REGS]	= {
996 		"ACC",  "REG1", "REG2", "REG3", "REG4",
997 		"REG5", "REG6", "REG7", "REG8",
998 	} ;
999 	int		i ;
1000 	TLispEntity*	pReg ;
1001 
1002 	for (i = LM_LREG_ACC ; i < MAX_LISPOBJ_REGS ; i ++) {
1003 		lispMachineCode_GetLReg (pLM, i, &pReg) ;
1004 		fprintf (stderr, "%s = ", apName [i - LM_LREG_ACC]) ;
1005 		if (pReg != NULL) {
1006 			lispEntity_Print (pLM->m_pLispMgr, pReg) ;
1007 		} else {
1008 			fprintf (stderr, "(null)") ;
1009 		}
1010 		fprintf (stderr, "\n") ;
1011 	}
1012 	return	True ;
1013 }
1014 #endif
1015 
1016