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