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 "lmachinep.h"
25 #include "lmkeymap.h"
26 
27 typedef struct {
28 	TLispEntity*	m_pEntDefinition ;
29 	TVarbuffer*		m_pvbufKeySeq ;
30 	TLispConscell*	m_plstResult ;
31 	Boolean			m_fOnce ;
32 }	TLispWhereIsInternalArg ;
33 
34 typedef struct {
35 	TLispEntity*	m_pEntKey ;
36 	int				m_nLength ;
37 	Boolean			m_fNearMatch ;
38 	Boolean			m_fAcceptDefault ;
39 	int				m_nMatch ;
40 	TLispEntity*	m_pEntFunc ;
41 }	TLispKeyBindingArg ;
42 
43 static	Boolean	lispMachine_keybindingLookupKey	(TLispMachine*, TLispEntity*, TLispKeyBindingArg*) ;
44 static	Boolean	lispMachine_keybindingEnum		(TLispMachine*, TLispEntity*, void*, Boolean*) ;
45 static	Boolean	lispMachine_whereIsInternal1keymap(TLispMachine*, TLispEntity*, TLispEntity*, TVarbuffer*, TLispConscell*) ;
46 static	Boolean	lispMachine_whereIsInternalVector(TLispMachine*, TLispEntity*, TLispEntity*, TVarbuffer*, TLispConscell*) ;
47 static	Boolean	lispMachine_whereIsInternalCons	(TLispMachine*, TLispEntity*, TLispEntity*, TVarbuffer*, TLispConscell*) ;
48 static	Boolean	lispMachine_whereIsInternalEnum	(TLispMachine*, TLispEntity*, void*, Boolean*) ;
49 
50 /*
51  *	(keymap CHARTABLE . ALIST) �Ȥ������ο����������ޥåפ��ä��֤���
52  *	CHARTABLE �ϼºݤˤ� ASCII ʸ��������줿 char-table �ʤΤ�����
53  *	vector �����Ѥ��Ƥ��롣ALIST �� function key �� mouse event �ʤ�
54  *	input stream �ˤ������¾�β��������ä� assoc-list �Ǥ��롣
55  *	���ƤΥ���ȥ�Ϻǽ�� nil �ˡ���command undefined�פ��̣���Ƥ�
56  *	�뤬�����������Ƥ��롣
57  *
58  *	optional �� STRING �ϥ����ޥåפΥ�˥塼̾��Ϳ���Ƥ��롣x-popup-menu
59  *	�ǻȤ��餷����
60  *
61  *	(make-keymap &optional STRING)
62  */
63 TLMRESULT
lispMachineState_MakeKeymap(register TLispMachine * pLM)64 lispMachineState_MakeKeymap (
65 	register TLispMachine* pLM)
66 {
67 	register TLispManager*	pLispMgr ;
68 	TLispEntity*	pArglist ;
69 	TLispEntity*	pString ;
70 	TLispEntity*	pKeymap ;
71 
72 	assert (pLM != NULL) ;
73 	pLispMgr	= pLM->m_pLispMgr ;
74 	assert (pLispMgr != NULL) ;
75 
76 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pArglist) ;
77 	if (TFAILED (lispEntity_GetCar (pLispMgr, pArglist, &pString))) {
78 		lispMachineCode_SetError (pLM) ;
79 		return	LMR_RETURN ;
80 	}
81 	if (TFAILED (lispMgr_CreateKeymap (pLispMgr, pString, &pKeymap)))
82 		return	LMR_ERROR ;
83 	lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pKeymap) ;
84 	return	LMR_RETURN ;
85 }
86 
87 /*
88  *	(make-sparse-keymap &optional STRING)
89  */
90 TLMRESULT
lispMachineState_MakeSparseKeymap(register TLispMachine * pLM)91 lispMachineState_MakeSparseKeymap (
92 	register TLispMachine* pLM)
93 {
94 	register TLispManager*	pLispMgr ;
95 	TLispEntity*	pArglist ;
96 	TLispEntity*	pString ;
97 	TLispEntity*	pKeymap ;
98 
99 	assert (pLM != NULL) ;
100 	pLispMgr	= pLM->m_pLispMgr ;
101 	assert (pLispMgr != NULL) ;
102 
103 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pArglist) ;
104 	if (TFAILED (lispEntity_GetCar (pLispMgr, pArglist, &pString))) {
105 		lispMachineCode_SetError (pLM) ;
106 		return	LMR_RETURN ;
107 	}
108 	if (TFAILED (lispMgr_CreateSparseKeymap (pLispMgr, pString, &pKeymap)))
109 		return	LMR_ERROR ;
110 	lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pKeymap) ;
111 	return	LMR_RETURN ;
112 }
113 
114 TLMRESULT
lispMachineState_CopyKeymap(register TLispMachine * pLM)115 lispMachineState_CopyKeymap (
116 	register TLispMachine* pLM)
117 {
118 	register TLispManager*	pLispMgr ;
119 	TLispEntity*	pEntArglist ;
120 	TLispEntity*	pEntKeymap ;
121 	TLispEntity*	pEntRetval ;
122 
123 	assert (pLM != NULL) ;
124 	pLispMgr	= pLM->m_pLispMgr ;
125 	assert (pLispMgr != NULL) ;
126 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
127 	lispEntity_GetCar (pLispMgr, pEntArglist, &pEntKeymap) ;
128 	if (TFAILED (lispMgr_CopyKeymap (pLispMgr, pEntKeymap, &pEntRetval))) {
129 		lispMachineCode_SetError (pLM) ;
130 	} else {
131 		lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pEntRetval) ;
132 	}
133 	return	LMR_RETURN ;
134 }
135 
136 /*
137  *	(keymapp OBJECT)
138  *
139  *	keymapp �� built-in function �Ǥ��롣
140  *	�⤷ OBJECT �������ޥåפǤ���С�t ���֤���
141  *	�����ޥåפ� (keymap . ALIST) �ޤ��ϡ����δؿ�������������ޥåפǤ���
142  *	����ܥ�Ǥ���(���θ�Ԥ�ʸ�Ϥϰ�̣������)��
143  *	ALIST �����Ǥ� (CHAR . DEFN) �ޤ��� (SYMBOL . DEFN) �Τ褦�ʷ����Ƥ�
144  *	�롣vector �λ��ϡġ�
145  */
146 TLMRESULT
lispMachineState_Keymapp(register TLispMachine * pLM)147 lispMachineState_Keymapp (
148 	register TLispMachine*	pLM)
149 {
150 	register TLispManager*	pLispMgr ;
151 	TLispEntity*	pArglist ;
152 	TLispEntity*	pEntity ;
153 	TLispEntity*	pRetval ;
154 
155 	assert (pLM != NULL) ;
156 
157 	pLispMgr	= pLM->m_pLispMgr ;
158 	assert (pLispMgr != NULL) ;
159 
160 	/*
161 	 *	�����ʳ��Ǥϰ����� Eval �ϺѤ�Ǥ��롣
162 	 *	�����ϥꥹ�ȤȤʤäơ�ACC �����äƤ��롣
163 	 */
164 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pArglist) ;
165 
166 	if (TFAILED (lispEntity_GetCar (pLispMgr, pArglist, &pEntity))) {
167 		lispMachineCode_SetError (pLM) ;
168 		return	LMR_RETURN ;
169 	}
170 	if (TSUCCEEDED (lispEntity_Keymapp (pLispMgr, pEntity))) {
171 		lispMgr_CreateT   (pLispMgr, &pRetval) ;
172 	} else {
173 		lispMgr_CreateNil (pLispMgr, &pRetval) ;
174 	}
175 	lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pRetval) ;
176 	return	LMR_RETURN ;
177 }
178 
179 /*
180  *
181  */
182 TLMRESULT
lispMachineState_LookupKey(register TLispMachine * pLM)183 lispMachineState_LookupKey (
184 	register TLispMachine*	pLM)
185 {
186 	register TLispManager*	pLispMgr ;
187 	TLispEntity*	pArglist ;
188 	TLispEntity*	pKey ;
189 	TLispEntity*	pKeymap ;
190 	TLispEntity*	pFunction ;
191 	TLispEntity*	pAcceptDefault ;
192 	Boolean			fAcceptDefault ;
193 	int				nMatch ;
194 	int				nLength ;
195 
196 	assert (pLM != NULL) ;
197 	pLispMgr	= pLM->m_pLispMgr ;
198 	assert (pLispMgr != NULL) ;
199 
200 	/*
201 	 *	�����ʳ��Ǥϰ����� Eval �ϺѤ�Ǥ��롣
202 	 *	�����ϥꥹ�ȤȤʤäơ�ACC �����äƤ��롣
203 	 */
204 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pArglist) ;
205 	assert (pArglist != NULL) ;
206 
207 	if (TFAILED (lispEntity_GetCar  (pLispMgr, pArglist, &pKeymap)) ||
208 		TFAILED (lispEntity_GetCdr  (pLispMgr, pArglist, &pArglist)) ||
209 		TFAILED (lispEntity_GetCar  (pLispMgr, pArglist, &pKey)) ||
210 		TFAILED (lispEntity_GetCadr (pLispMgr, pArglist, &pAcceptDefault))) {
211 		lispMachineCode_SetError (pLM) ;
212 		return	LMR_RETURN ;
213 	}
214 	if (TFAILED (lispEntity_Nullp (pLispMgr, pAcceptDefault))) {
215 		fAcceptDefault	= True ;
216 	} else {
217 		fAcceptDefault	= False ;
218 	}
219 	/*	ACCEPT-DEFAULT �Ϥޤ��ʤ���*/
220 	nMatch	= 0 ;
221 	if (TFAILED (lispKeymap_Lookup (pLispMgr, pKeymap, pKey, fAcceptDefault, False, &nMatch, &pFunction)))
222 		lispMachineCode_SetError (pLM) ;
223 
224 	(void) lispEntity_GetLength (pLispMgr, pKey, &nLength) ;
225 	if (nLength == nMatch) {
226 		/*	100% ���פ������ˤϡ��֤��줿 function ���롣*/
227 		lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pFunction) ;
228 	} else {
229 		TLispEntity*	hInteger ;
230 
231 		/*	���פ���ʸ�������֤���*/
232 		if (TFAILED (lispMgr_CreateInteger (pLispMgr, nMatch, &hInteger)))
233 			return	LMR_ERROR ;
234 		lispMachineCode_SetLReg (pLM, LM_LREG_ACC, hInteger) ;
235 	}
236 	return	LMR_RETURN ;
237 }
238 
239 /*
240  *	(define-key KEYMAP KE DEF)
241  *
242  *	������ KEYMAP, KEY, DEF��KEYMAP ����� ������������ KEY ��
243  *	DEF �Ȥ���������롣KEYMAP �� keymap �Ǥ��롣KEY ��ʸ����ޤ�
244  *	�� symbol ��ʸ���ΤΥ٥��ȥ�Ǥ��롣
245  *	��ASCII ʸ�� (127 ��Ķ����) �� vector ��ȤäƤ���ʤ�ޤ��
246  *	���Ȥ��Ǥ��롣DEF �� key ������Ǥ��벿���Ǥ��롣
247  *	nil �� keymap �ˤ�����
248  *	command
249  *	string
250  *	keymap
251  *	symbol
252  *	cons (STRING . DEFN)
253  *	...
254  */
255 TLMRESULT
lispMachineState_DefineKey(register TLispMachine * pLM)256 lispMachineState_DefineKey (
257 	register TLispMachine* pLM)
258 {
259 	register TLispManager*	pLispMgr ;
260 	TLispEntity*	pArglist ;
261 	TLispEntity*	pKEYMAP ;
262 	TLispEntity*	pKEY ;
263 	TLispEntity*	pDEF ;
264 
265 	assert (pLM != NULL) ;
266 	pLispMgr	= pLM->m_pLispMgr ;
267 	assert (pLispMgr != NULL) ;
268 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pArglist) ;
269 	assert (pArglist != NULL) ;
270 
271 	if (TFAILED (lispEntity_GetCar  (pLispMgr, pArglist, &pKEYMAP)) ||
272 		TFAILED (lispEntity_GetCdr  (pLispMgr, pArglist, &pArglist)) ||
273 		TFAILED (lispEntity_GetCar  (pLispMgr, pArglist, &pKEY)) ||
274 		TFAILED (lispEntity_GetCadr (pLispMgr, pArglist, &pDEF))) {
275 		lispMachineCode_SetError (pLM) ;
276 		return	LMR_RETURN ;
277 	}
278 	/*	pKEY �� VECTOR �ξ��Ϻ��Ϲͤ��Ƥ��ʤ���*/
279 	if (TSUCCEEDED (lispEntity_Vectorp (pLispMgr, pKEY))) {
280 		TLispEntity**	ppEntKeySeq ;
281 		int				nKeySeq ;
282 
283 		(void) lispEntity_GetVectorValue (pLispMgr, pKEY, &ppEntKeySeq, &nKeySeq) ;
284 		if (TFAILED (lispKeymap_DefineKeyWithVector (pLispMgr, pKEYMAP, ppEntKeySeq, nKeySeq, pDEF)))
285 			lispMachineCode_SetError (pLM) ;
286 	} else {
287 		const Char*		pString ;
288 		int				nString ;
289 
290 		if (TFAILED (lispEntity_GetStringValue (pLispMgr, pKEY, &pString, &nString))) {
291 			lispMachineCode_SetError (pLM) ;
292 			return	LMR_RETURN ;
293 		}
294 		if (TFAILED (lispKeymap_DefineKey (pLispMgr, pKEYMAP, pString, nString, pDEF)))
295 			lispMachineCode_SetError (pLM) ;
296 	}
297 	lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pDEF) ;
298 	return	LMR_RETURN ;
299 }
300 
301 /*
302  *	(current-minor-mode-maps)
303  *
304  *	current-buffer �� minor-modes �˳����Ƥ��Ƥ��� keymap �Υꥹ��
305  *	���֤���
306  *
307  *	minor-mode-map-alist ������˰��פ����Τ���Ф��ơ�
308  *	(keymap1 keymap2 ...) �Ȥ��� list ���롣
309  */
310 TLMRESULT
lispMachineState_CurrentMinorModeMaps(register TLispMachine * pLM)311 lispMachineState_CurrentMinorModeMaps (
312 	register TLispMachine* pLM)
313 {
314 	register TLispManager*	pLispMgr ;
315 	TLispEntity*	pEntKeymaps ;
316 
317 	assert (pLM != NULL) ;
318 	pLispMgr	= pLM->m_pLispMgr ;
319 	assert (pLispMgr != NULL) ;
320 	if (TFAILED (lispMachineCode_CurrentMinorModeMaps (pLM, &pEntKeymaps))) {
321 		lispMachineCode_SetError (pLM) ;
322 	} else {
323 		lispMachineCode_SetLReg  (pLM, LM_LREG_1, pEntKeymaps) ;
324 	}
325 	return	LMR_RETURN ;
326 }
327 
328 /*
329  *	(use-local-map KEYMAP)
330  *
331  *	local keymap �Ȥ��� KEYMAP �������롣�⤷ KEYMAP �� nil �ʤ��
332  *	local keymap ��̵���ˤ��뤳�Ȥ��̣���롣
333  */
334 TLMRESULT
lispMachineState_UseLocalMap(register TLispMachine * pLM)335 lispMachineState_UseLocalMap (register TLispMachine* pLM)
336 {
337 	register TLispManager*	pLispMgr ;
338 	TLispEntity*	pEntArglist ;
339 	TLispEntity*	pEntKeymap ;
340 	TLispEntity*	pEntCurBuffer ;
341 
342 	assert (pLM != NULL) ;
343 	pLispMgr	= pLM->m_pLispMgr ;
344 	assert (pLispMgr != NULL) ;
345 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
346 	if (TFAILED (lispEntity_GetCar (pLispMgr, pEntArglist, &pEntKeymap)) ||
347 		TFAILED (lispMachineCode_GetCurrentBuffer (pLM, &pEntCurBuffer))) {
348 		lispMachineCode_SetError (pLM) ;
349 		return	LMR_RETURN ;
350 	}
351 	lispBuffer_SetKeymap (pLispMgr, pEntCurBuffer, pEntKeymap) ;
352 	lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pEntKeymap) ;
353 	return	LMR_RETURN ;
354 }
355 
356 /*
357  *	(current-local-map)
358  *
359  *	current-buffer �� local keymap ���֤����⤷���äƤ��ʤ����
360  *	nil ���֤���
361  */
362 TLMRESULT
lispMachineState_CurrentLocalMap(register TLispMachine * pLM)363 lispMachineState_CurrentLocalMap (
364 	register TLispMachine* pLM)
365 {
366 	register TLispManager*	pLispMgr ;
367 	TLispEntity*	pEntCurBuffer ;
368 	TLispEntity*	pEntKeymap ;
369 
370 	assert (pLM != NULL) ;
371 	pLispMgr	= pLM->m_pLispMgr ;
372 	assert (pLispMgr != NULL) ;
373 	if (TFAILED (lispMachineCode_GetCurrentBuffer (pLM, &pEntCurBuffer))) {
374 		lispMachineCode_SetError (pLM) ;
375 	} else {
376 		if (TFAILED (lispBuffer_GetKeymap (pEntCurBuffer, &pEntKeymap)) ||
377 			pEntKeymap == NULL)
378 			lispMgr_CreateNil (pLispMgr, &pEntKeymap) ;
379 		lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pEntKeymap) ;
380 	}
381 	return	LMR_RETURN ;
382 }
383 
384 /*
385  *	(where-is-internal DEFINITION &optional KEYMAP FIRSTONLY NOINDIRECT)
386  *
387  *	DEFINITION ��ƤӽФ������Υꥹ�Ȥ��֤���
388  *	�⤷ KEYMAP �� nil �Ǥʤ���С����� KEYMAP �� global keymap ������
389  *	�����롣
390  *	�⤷ KEYMAP �� nil �ʤ�С����� active �� keymap �����Ƥ������롣
391  *	�⤷ KEYMAP �� keymap �Υꥹ�ȤǤ���С������� keymap ����������
392  *	�롣
393  *
394  *	3���ܤΰ��� FIRSTONLY �� nil �Ǥʤ���С����դ��ä��ǽ�Υ���������
395  *	�����֤���(���ƤΥ������������Ǥʤ�)
396  *	�⤷ FIRSTONLY ������ܥ� `non-ascii' �ʤ�С����줬���Ǥ��뤫�ˤ���
397  *	��餺�ǽ�˸��դ��ä��Х���ǥ������֤���
398  *	FIRSTONLY ���̤� non-nil value �Ǥ���С�ASCII ʸ���Υ������������֡�
399  *	��˥塼�Х���ǥ����ϵ��ݤ���롣
400  *	4���ܤΰ��� NOINDIRECT �� non-nil �ʤ�С�¾�Υ����ޥåפޤ��� slot
401  *	�ؤδ��ܻ��Ȥ˽���ʤ�������ϴ���Ū������������뤳�Ȥ��ǽ�ˤ��롣
402  *	If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
403  *	to other keymaps or slots.  This makes it possible to search for an
404  *	indirect definition itself.
405  *
406  *	current-minor-mode-maps, current-local-map, global-map
407  */
408 TLMRESULT
lispMachineState_WhereIsInternal(register TLispMachine * pLM)409 lispMachineState_WhereIsInternal (
410 	register TLispMachine* pLM)
411 {
412 	register TLispManager*	pLispMgr ;
413 	TLispEntity*			pEntArglist ;
414 	TLispEntity*			pEntDefinition ;
415 	TLispEntity*			pEntKeymap ;
416 	register TLispEntity*	pEntGlobalMap ;
417 	TLispConscell			lstResult ;
418 	TVarbuffer				vbufKeySeq ;
419 
420 	assert (pLM != NULL) ;
421 	pLispMgr	= pLM->m_pLispMgr ;
422 	assert (pLispMgr != NULL) ;
423 
424 	/*	���ΤȤ�����3����4������ư��ʤ���*/
425 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
426 	if (TFAILED (lispEntity_GetCar (pLispMgr, pEntArglist, &pEntDefinition)) ||
427 		TFAILED (lispEntity_GetCdr (pLispMgr, pEntArglist, &pEntArglist))    ||
428 		TFAILED (lispEntity_GetCar (pLispMgr, pEntArglist, &pEntKeymap))) {
429 		lispMachineCode_SetError (pLM) ;
430 		return	LMR_RETURN ;
431 	}
432 	if (TFAILED (TVarbuffer_Initialize (&vbufKeySeq, sizeof (TLispEntity*))))
433 		return	LMR_ERROR ;
434 
435 	lstResult.m_pCar	= lstResult.m_pCdr	= NULL ;
436 	if (TFAILED (lispEntity_Nullp (pLispMgr, pEntKeymap))) {
437 		if (TSUCCEEDED (lispEntity_Keymapp (pLispMgr, pEntKeymap))) {
438 			if (TFAILED (lispMachine_whereIsInternal1keymap (pLM, pEntKeymap, pEntDefinition, &vbufKeySeq, &lstResult)))
439 				goto	error ;
440 			TVarbuffer_Clear (&vbufKeySeq) ;
441 		} else {
442 			TLispEntity*	pEntTarget ;
443 			TLispEntity*	pEntNext ;
444 
445 			if (TFAILED (lispEntity_Consp (pLispMgr, pEntKeymap)))
446 				goto	error ;
447 
448 			while (TFAILED (lispEntity_Nullp (pLispMgr, pEntKeymap))) {
449 				if (TFAILED (lispEntity_GetCar (pLispMgr, pEntKeymap, &pEntTarget)) ||
450 					TFAILED (lispEntity_GetCdr (pLispMgr, pEntKeymap, &pEntNext)))
451 					goto	error ;
452 				if (TFAILED (lispMachine_whereIsInternal1keymap (pLM, pEntTarget, pEntDefinition, &vbufKeySeq, &lstResult)))
453 					goto	error ;
454 				TVarbuffer_Clear (&vbufKeySeq) ;
455 				pEntKeymap	= pEntNext ;
456 			}
457 		}
458 	} else {
459 		TLispWhereIsInternalArg	arg ;
460 		TLispEntity*			pEntCurBuffer ;
461 
462 		/*	���� active �� keymap �����Ƹ�������... sigh
463 		 *	�Ĥޤꡢ
464 		 *		1. minor-mode-map-alist ��
465 		 *		2. local-map ��
466 		 *		3. global-map ��
467 		 *	�������뤳�Ȥˤʤ롣
468 		 */
469 		arg.m_pEntDefinition	= pEntDefinition ;
470 		arg.m_pvbufKeySeq		= &vbufKeySeq ;
471 		arg.m_plstResult		= &lstResult ;
472 		lispMachine_EnumMinorModeMaps (pLM, lispMachine_whereIsInternalEnum, &arg) ;
473 
474 		if (TFAILED (lispMachineCode_GetCurrentBuffer (pLM, &pEntCurBuffer)))
475 			goto	error ;
476 		if (TSUCCEEDED (lispBuffer_GetKeymap (pEntCurBuffer, &pEntKeymap)) ||
477 			pEntKeymap != NULL) {
478 			if (TFAILED (lispMachine_whereIsInternal1keymap (pLM, pEntKeymap, pEntDefinition, &vbufKeySeq, &lstResult)))
479 				goto	error ;
480 			TVarbuffer_Clear (&vbufKeySeq) ;
481 		}
482 	}
483 
484 	/*	������ global-map �������롣
485 	 */
486 	pEntGlobalMap	= lispMachine_GetGlobalMap (pLM) ;
487 	if (TFAILED (lispMachine_whereIsInternal1keymap (pLM, pEntGlobalMap, pEntDefinition, &vbufKeySeq, &lstResult)))
488 		goto	error ;
489 
490 	if (lstResult.m_pCar == NULL) {
491 		lispMachineCode_SetLReg (pLM, LM_LREG_ACC, lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_NIL)) ;
492 	} else {
493 		lispMachineCode_SetLReg (pLM, LM_LREG_ACC, lstResult.m_pCar) ;
494 		lispEntity_Release (pLispMgr, lstResult.m_pCar) ;
495 	}
496 	return	LMR_RETURN ;
497 
498   error:
499 	TVarbuffer_Uninitialize (&vbufKeySeq) ;
500 	if (lstResult.m_pCar != NULL)
501 		lispEntity_Release (pLispMgr, lstResult.m_pCar) ;
502 	lispMachineCode_SetError (pLM) ;
503 	return	LMR_RETURN ;
504 }
505 
506 /*	built-in function
507  *		(key-binding KEY &optional ACCEPT-DEFAULT)
508  *
509  *	���ߤ� keymap �� KEY ���Ф��륳�ޥ�ɤ��֤���KEY ��ʸ����ޤ���
510  *	�٥��ȥ�ޤ��ϥ������ȥ�������Ǥ��롣�����Х���ɤ�¿ʬ���ؿ�
511  *	�������ä�����ܥ�Ǥ�����
512  *
513  *	������key-binding �� default �ΥХ���ǥ����Ȥ���ư��� t ��
514  *	�Ф���Х���ǥ�����̵�뤹�롣
515  */
516 TLMRESULT
lispMachineState_KeyBinding(register TLispMachine * pLM)517 lispMachineState_KeyBinding (
518 	register TLispMachine*	pLM)
519 {
520 	register TLispManager*	pLispMgr	= pLM->m_pLispMgr ;
521 	TLispEntity*		pEntArglist ;
522 	TLispEntity*		pEntKey ;
523 	TLispEntity*		pEntAcceptDefault ;
524 	TLispEntity*		pEntKeymap ;
525 	TLispEntity*		pEntFunc ;
526 	TLispKeyBindingArg	arg ;
527 	TLispEntity*		pEntCurBuffer ;
528 	Boolean				fAcceptDefault ;
529 	int					nLength ;
530 
531 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
532 	lispEntity_GetCar  (pLispMgr, pEntArglist, &pEntKey) ;
533 	lispEntity_GetCadr (pLispMgr, pEntArglist, &pEntAcceptDefault) ;
534 	fAcceptDefault	= !lispEntity_Nullp (pLispMgr, pEntAcceptDefault) ;
535 
536 	if (TFAILED (lispEntity_GetLength (pLispMgr, pEntKey, &nLength))) {
537 		lispMachineCode_SetError (pLM) ;
538 		return	LMR_RETURN ;
539 	}
540 
541 	/*		1. minor-mode-map-alist �������롣*/
542 	arg.m_pEntKey			= pEntKey ;
543 	arg.m_nLength			= nLength ;
544 	arg.m_fAcceptDefault	= fAcceptDefault ;
545 	arg.m_fNearMatch		= False ;
546 	arg.m_pEntFunc			= NULL ;
547 	lispMachine_EnumMinorModeMaps (pLM, lispMachine_keybindingEnum, &arg) ;
548 	if (arg.m_nMatch > 0 && arg.m_pEntFunc != NULL) {
549 		pEntFunc	= arg.m_pEntFunc ;
550 		goto	found ;
551 	}
552 	/*		2. local-map �������롣*/
553 	lispMachineCode_GetCurrentBuffer (pLM, &pEntCurBuffer) ;
554 	assert (pEntCurBuffer != NULL) ;
555 	(void) lispBuffer_GetKeymap (pEntCurBuffer, &pEntKeymap) ;
556 	(void) lispMachine_keybindingLookupKey (pLM, pEntKeymap, &arg) ;
557 	if (arg.m_nMatch > 0 && arg.m_pEntFunc != NULL) {
558 		pEntFunc	= arg.m_pEntFunc ;
559 		goto	found ;
560 	}
561 
562 	/*		3. global-map �������롣*/
563 	pEntKeymap	= lispMachine_GetGlobalMap (pLM) ;
564 	(void) lispMachine_keybindingLookupKey (pLM, pEntKeymap, &arg) ;
565 	if (arg.m_nMatch > 0 && arg.m_pEntFunc != NULL) {
566 		pEntFunc	= arg.m_pEntFunc ;
567 	} else {
568 		pEntFunc	= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_NIL) ;
569 	}
570   found:
571 	lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pEntFunc) ;
572 	return	LMR_RETURN ;
573 }
574 
575 /*	built-in function
576  *		(j-key-binding KEY &optional ACCEPT-DEFAULT)
577  *
578  *	���ߤ� keymap �� KEY ���Ф��륳�ޥ�ɤ��֤���KEY ��ʸ����ޤ���
579  *	�٥��ȥ�ޤ��ϥ������ȥ�������Ǥ��롣�����Х���ɤ�¿ʬ���ؿ�
580  *	�������ä�����ܥ�Ǥ�����
581  *
582  *	������key-binding �� default �ΥХ���ǥ����Ȥ���ư��� t ��
583  *	�Ф���Х���ǥ�����̵�뤹�롣
584  *
585  *��
586  *	key-binding �Ȥ�ư��ΰ㤤�ϡ�window-proc ��Ʊ�ͤΥ���Ƚ�����
587  *	�Ȥ���Ǥ��롣�����顢�㤨�С�\C-\S-t �� bind ��Ĵ�٤���ˤ�
588  *	\C-\S-t �� bind �μ��� \C-t �� bind ���롣
589  */
590 TLMRESULT
lispMachineState_JKeyBinding(register TLispMachine * pLM)591 lispMachineState_JKeyBinding (
592 	register TLispMachine*	pLM)
593 {
594 	register TLispManager*	pLispMgr	= pLM->m_pLispMgr ;
595 	TLispEntity*		pEntArglist ;
596 	TLispEntity*		pEntKey ;
597 	TLispEntity*		pEntAcceptDefault ;
598 	TLispEntity*		pEntKeymap ;
599 	TLispEntity*		pEntGlobalKeymap ;
600 	TLispEntity*		pEntFunc ;
601 	TLispKeyBindingArg	arg ;
602 	TLispEntity*		pEntCurBuffer ;
603 	Boolean				fAcceptDefault ;
604 	int					nLength ;
605 	register int		i ;
606 	static Boolean		afNearMatch []	= { False, True, } ;
607 
608 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
609 	lispEntity_GetCar  (pLispMgr, pEntArglist, &pEntKey) ;
610 	lispEntity_GetCadr (pLispMgr, pEntArglist, &pEntAcceptDefault) ;
611 	fAcceptDefault	= !lispEntity_Nullp (pLispMgr, pEntAcceptDefault) ;
612 
613 	if (TFAILED (lispEntity_GetLength (pLispMgr, pEntKey, &nLength))) {
614 		lispMachineCode_SetError (pLM) ;
615 		return	LMR_RETURN ;
616 	}
617 
618 	lispMachineCode_GetCurrentBuffer (pLM, &pEntCurBuffer) ;
619 	assert (pEntCurBuffer != NULL) ;
620 	(void) lispBuffer_GetKeymap (pEntCurBuffer, &pEntKeymap) ;
621 	pEntGlobalKeymap	= lispMachine_GetGlobalMap (pLM) ;
622 
623 	arg.m_pEntKey			= pEntKey ;
624 	arg.m_nLength			= nLength ;
625 	arg.m_fAcceptDefault	= fAcceptDefault ;
626 	arg.m_pEntFunc			= NULL ;
627 
628 	for (i = 0 ; i < NELEMENTS (afNearMatch) ; i ++) {
629 		/*		1. minor-mode-map-alist �������롣*/
630 		arg.m_fNearMatch		= afNearMatch [i] ;
631 		lispMachine_EnumMinorModeMaps (pLM, lispMachine_keybindingEnum, &arg) ;
632 		if (arg.m_nMatch > 0 && arg.m_pEntFunc != NULL) {
633 			pEntFunc	= arg.m_pEntFunc ;
634 			goto	found ;
635 		}
636 		/*		2. local-map �������롣*/
637 		(void) lispMachine_keybindingLookupKey (pLM, pEntKeymap, &arg) ;
638 		if (arg.m_nMatch > 0 && arg.m_pEntFunc != NULL) {
639 			pEntFunc	= arg.m_pEntFunc ;
640 			goto	found ;
641 		}
642 		/*		3. global-map �������롣*/
643 		(void) lispMachine_keybindingLookupKey (pLM, pEntGlobalKeymap, &arg) ;
644 		if (arg.m_nMatch > 0 && arg.m_pEntFunc != NULL) {
645 			pEntFunc	= arg.m_pEntFunc ;
646 			goto	found ;
647 		}
648 	}
649 	pEntFunc	= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_NIL) ;
650   found:
651 	lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pEntFunc) ;
652 	return	LMR_RETURN ;
653 }
654 
655 /*========================================================================*
656  *	private functions
657  */
658 Boolean
lispMachine_keybindingLookupKey(register TLispMachine * pLM,register TLispEntity * pEntKeymap,register TLispKeyBindingArg * pArg)659 lispMachine_keybindingLookupKey (
660 	register TLispMachine*			pLM,
661 	register TLispEntity*			pEntKeymap,
662 	register TLispKeyBindingArg*	pArg)
663 {
664 	register TLispManager*	pLispMgr	= pLM->m_pLispMgr ;
665 	register TLispEntity*	pEntKey ;
666 	register int			nLength ;
667 	register Boolean		fNearMatch ;
668 	register Boolean		fAcceptDefault ;
669 	int						nMatch ;
670 	TLispEntity*			pEntFunc ;
671 
672 	pEntKey			= pArg->m_pEntKey ;
673 	nLength			= pArg->m_nLength ;
674 	fNearMatch		= pArg->m_fNearMatch ;
675 	fAcceptDefault	= pArg->m_fAcceptDefault ;
676 	nMatch			= 0 ;
677 	pEntFunc		= NULL ;
678 	if (TSUCCEEDED (lispKeymap_Lookup (pLispMgr, pEntKeymap, pEntKey, fAcceptDefault, fNearMatch, &nMatch, &pEntFunc)) &&
679 		TFAILED (lispEntity_Nullp (pLispMgr, pEntFunc)) &&
680 		nMatch > 0 && (nMatch == nLength || fAcceptDefault)) {
681 		pArg->m_nMatch		= nMatch ;
682 		pArg->m_pEntFunc	= pEntFunc ;
683 	} else {
684 		pArg->m_nMatch		= 0 ;
685 		pArg->m_pEntFunc	= NULL ;
686 	}
687 	return	True ;
688 }
689 
690 Boolean
lispMachine_keybindingEnum(register TLispMachine * pLM,register TLispEntity * pEntKeymap,register void * pCaller,register Boolean * pfContinue)691 lispMachine_keybindingEnum (
692 	register TLispMachine*	pLM,
693 	register TLispEntity*	pEntKeymap,
694 	register void*			pCaller,
695 	register Boolean*		pfContinue)
696 {
697 	register TLispKeyBindingArg*	pArg	= (TLispKeyBindingArg *) pCaller ;
698 
699 	if (TFAILED (lispMachine_keybindingLookupKey (pLM, pEntKeymap, pArg)))
700 		return	False ;
701 	if (pArg->m_nMatch > 0 && pArg->m_pEntFunc != NULL)
702 		*pfContinue	= False ;
703 	return	True ;
704 }
705 
706 /*	1 keymap ���Ф��� where-is-internal ��ư���Ԥ���
707  */
708 Boolean
lispMachine_whereIsInternal1keymap(register TLispMachine * pLM,register TLispEntity * pEntKeymap,register TLispEntity * pEntSymbol,register TVarbuffer * pvbufKeySeq,register TLispConscell * pEntRetval)709 lispMachine_whereIsInternal1keymap (
710 	register TLispMachine*	pLM,
711 	register TLispEntity*	pEntKeymap,
712 	register TLispEntity*	pEntSymbol,
713 	register TVarbuffer*	pvbufKeySeq,
714 	register TLispConscell*	pEntRetval)
715 {
716 	register TLispManager*	pLispMgr ;
717 	TLispEntity*	pEntTarget ;
718 	TLispEntity*	pEntNext ;
719 	int				nType ;
720 
721 	assert (pLM != NULL) ;
722 	pLispMgr	= pLM->m_pLispMgr ;
723 	assert (pLispMgr != NULL) ;
724 
725 	if (pEntKeymap == NULL ||
726 		TFAILED (lispEntity_Keymapp (pLispMgr, pEntKeymap)))	/* null ��̵�뤹�롣*/
727 		return	True ;
728 
729 	(void) lispEntity_GetCdr (pLispMgr, pEntKeymap, &pEntNext) ;
730 	pEntKeymap	= pEntNext ;
731 
732 	while (TFAILED (lispEntity_Nullp (pLispMgr, pEntKeymap))) {
733 		if (TFAILED (lispEntity_GetCar (pLispMgr, pEntKeymap, &pEntTarget)) ||
734 			TFAILED (lispEntity_GetCdr (pLispMgr, pEntKeymap, &pEntNext)))
735 			return	False ;
736 		(void) lispEntity_GetType (pLispMgr, pEntTarget, &nType) ;
737 		switch (nType) {
738 		case	LISPENTITY_VECTOR:
739 			if (TFAILED (lispMachine_whereIsInternalVector (pLM, pEntTarget, pEntSymbol, pvbufKeySeq, pEntRetval)))
740 				return	False ;
741 			break ;
742 		case	LISPENTITY_CONSCELL:
743 			if (TFAILED (lispMachine_whereIsInternalCons (pLM, pEntTarget, pEntSymbol, pvbufKeySeq, pEntRetval)))
744 				return	False ;
745 			break ;
746 		default:
747 			/*	¿ʬ�˥��顼���ʡ�*/
748 			return	False ;
749 		}
750 		pEntKeymap	= pEntNext ;
751 	}
752 	return	True ;
753 }
754 
755 Boolean
lispMachine_whereIsInternalVector(register TLispMachine * pLM,register TLispEntity * pEntVector,register TLispEntity * pEntSymbol,register TVarbuffer * pvbufKeySeq,register TLispConscell * pEntRetval)756 lispMachine_whereIsInternalVector (
757 	register TLispMachine*	pLM,
758 	register TLispEntity*	pEntVector,
759 	register TLispEntity*	pEntSymbol,
760 	register TVarbuffer*	pvbufKeySeq,
761 	register TLispConscell*	pEntRetval)
762 {
763 	register TLispManager*	pLispMgr ;
764 	TLispEntity**			ppElements ;
765 	int						nElements ;
766 	register TLispEntity**	ptr ;
767 	register int			i ;
768 	TLispEntity*			pEntKey ;
769 	TLispEntity*			pEntResult ;
770 	register Boolean		f ;
771 
772 	assert (pLM != NULL) ;
773 	pLispMgr	= pLM->m_pLispMgr ;
774 	assert (pLispMgr != NULL) ;
775 
776 	if (TFAILED (lispEntity_GetVectorValue (pLispMgr, pEntVector, &ppElements, &nElements)))
777 		return	False ;
778 
779 	for (i = 0, ptr = ppElements ; i < nElements ; i ++, ptr ++) {
780 		if (TSUCCEEDED (lispEntity_Eq (pLispMgr, *ptr, pEntSymbol))) {
781 			register TLispEntity**	pEntKeySeq ;
782 			register int			nKeySeq ;
783 
784 			if (TFAILED (lispMgr_CreateInteger (pLispMgr, (long)i, &pEntKey)))
785 				return	False ;
786 			if (TFAILED (TVarbuffer_Add (pvbufKeySeq, &pEntKey, 1)))
787 				return	False ;
788 			pEntKeySeq	= (TLispEntity **)TVarbuffer_GetBuffer (pvbufKeySeq) ;
789 			nKeySeq		= TVarbuffer_GetUsage (pvbufKeySeq) ;
790 			lispEntity_AddRef (pLispMgr, pEntKey) ;
791 			f	= lispMgr_CreateVector (pLispMgr, pEntKeySeq, nKeySeq, &pEntResult) ;
792 			lispEntity_Release (pLispMgr, pEntKey) ;
793 			if (TFAILED (f) || pEntResult == NULL)
794 				return	False ;
795 			lispEntity_AddRef (pLispMgr, pEntResult) ;
796 			f	= lispEntity_Push2List (pLispMgr, pEntRetval, pEntResult) ;
797 			lispEntity_Release (pLispMgr, pEntResult) ;
798 			if (TFAILED (f))
799 				return	False ;
800 		}
801 	}
802 	return	True ;
803 }
804 
805 Boolean
lispMachine_whereIsInternalCons(register TLispMachine * pLM,register TLispEntity * pEntCons,register TLispEntity * pEntSymbol,register TVarbuffer * pvbufKeySeq,register TLispConscell * pEntRetval)806 lispMachine_whereIsInternalCons (
807 	register TLispMachine*	pLM,
808 	register TLispEntity*	pEntCons,
809 	register TLispEntity*	pEntSymbol,
810 	register TVarbuffer*	pvbufKeySeq,
811 	register TLispConscell*	pEntRetval)
812 {
813 	register TLispManager*	pLispMgr ;
814 	TLispEntity*			pEntKey ;
815 	TLispEntity*			pEntFunc ;
816 	TLispEntity*			pEntResult ;
817 	register Boolean		f ;
818 
819 	assert (pLM != NULL) ;
820 	pLispMgr	= pLM->m_pLispMgr ;
821 	assert (pLispMgr != NULL) ;
822 
823 	if (TFAILED (lispEntity_GetCar (pLispMgr, pEntCons, &pEntKey)) ||
824 		TFAILED (lispEntity_GetCdr (pLispMgr, pEntCons, &pEntFunc)))
825 		return	False ;
826 
827 	if (TSUCCEEDED (lispEntity_Symbolp (pLispMgr, pEntFunc))) {
828 		if (TSUCCEEDED (lispEntity_Eq (pLispMgr, pEntFunc, pEntSymbol))) {
829 			register TLispEntity**	pEntKeySeq ;
830 			register int			nKeySeq ;
831 
832 			if (TFAILED (TVarbuffer_Add (pvbufKeySeq, &pEntKey, 1)))
833 				return	False ;
834 
835 			pEntKeySeq	= (TLispEntity **)TVarbuffer_GetBuffer (pvbufKeySeq) ;
836 			nKeySeq		= TVarbuffer_GetUsage (pvbufKeySeq) ;
837 			lispEntity_AddRef (pLispMgr, pEntKey) ;
838 			f	= lispMgr_CreateVector (pLispMgr, pEntKeySeq, nKeySeq, &pEntResult) ;
839 			lispEntity_Release (pLispMgr, pEntKey) ;
840 			if (TFAILED (f) || pEntResult == NULL)
841 				return	False ;
842 
843 			lispEntity_AddRef (pLispMgr, pEntResult) ;
844 			f	= lispEntity_Push2List (pLispMgr, pEntRetval, pEntResult) ;
845 			lispEntity_Release (pLispMgr, pEntResult) ;
846 			if (TFAILED (f))
847 				return	False ;
848 		}
849 		return	True ;
850 	}
851 	if (TFAILED (lispEntity_Keymapp (pLispMgr, pEntFunc)))
852 		return	False ;
853 
854 	if (TFAILED (TVarbuffer_Add (pvbufKeySeq, &pEntKey, 1)))
855 		return	False ;
856 
857 	f	= lispMachine_whereIsInternal1keymap (pLM, pEntFunc, pEntSymbol, pvbufKeySeq, pEntRetval) ;
858 	(void) TVarbuffer_Sub (pvbufKeySeq, 1) ;
859 	return	f ;
860 }
861 
862 Boolean
lispMachine_whereIsInternalEnum(register TLispMachine * pLM,register TLispEntity * pEntKeymap,register void * pCaller,register Boolean * pfContinue)863 lispMachine_whereIsInternalEnum (
864 	register TLispMachine*	pLM,
865 	register TLispEntity*	pEntKeymap,
866 	register void*			pCaller,
867 	register Boolean*		pfContinue)
868 {
869 	register TLispWhereIsInternalArg*	pArg	= (TLispWhereIsInternalArg*) pCaller ;
870 	register TLispEntity*	pEntDef ;
871 	register TVarbuffer*	pvbuf ;
872 	register TLispConscell*	pResult ;
873 
874 	pEntDef	= pArg->m_pEntDefinition ;
875 	pvbuf	= pArg->m_pvbufKeySeq ;
876 	pResult	= pArg->m_plstResult ;
877 	if (TFAILED (lispMachine_whereIsInternal1keymap (pLM, pEntKeymap, pEntDef, pvbuf, pResult)))
878 		return	False ;
879 
880 	TVarbuffer_Clear (pvbuf) ;
881 	return	True ;
882 }
883 
884