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 
26 static	TLMRESULT	lispMachine_killRegion	(TLispMachine*, TLispEntity*, TBufStringMarker*, int, int) ;
27 static	Boolean		lispMachine_currentKill	(TLispMachine*, int, Boolean, TLispEntity**) ;
28 
29 /*
30  *	(transporse-chars ARG)
31  */
32 TLMRESULT
lispMachineState_TransposeChars(register TLispMachine * pLM)33 lispMachineState_TransposeChars (
34 	register TLispMachine* pLM)
35 {
36 	return	LMR_RETURN ;
37 }
38 
39 /*
40  */
41 TLMRESULT
lispMachineState_SetMark(register TLispMachine * pLM)42 lispMachineState_SetMark (
43 	register TLispMachine*	pLM)
44 {
45 	register TLispManager*	pLispMgr	= pLM->m_pLispMgr ;
46 	TLispEntity*	pEntArglist ;
47 	TLispEntity*	pEntPOS ;
48 	TLispEntity*	pEntBuffer ;
49 	TLispEntity*	pEntMark ;
50 
51 	assert (pLM      != NULL) ;
52 	assert (pLispMgr != NULL) ;
53 
54 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
55 	assert (pEntArglist != NULL) ;
56 	lispMachineCode_GetCurrentBuffer (pLM, &pEntBuffer) ;
57 	lispEntity_GetCar     (pLispMgr, pEntArglist, &pEntPOS) ;
58 	lispBuffer_MarkMarker (pLispMgr, pEntBuffer, &pEntMark) ;
59 	if (TSUCCEEDED (lispEntity_Nullp (pLispMgr, pEntPOS))) {
60 		/*	nil �ʤ�Хåե������������*/
61 		lispBuffer_RemoveMarker (pLispMgr, pEntMark) ;
62 	} else {
63 		TLispNumber		numPOS ;
64 		register int	nPOS ;
65 		int				nBufferTop, nBufferEnd ;
66 
67 		if (TFAILED (lispEntity_GetNumberValueOrMarkerPosition (pLispMgr, pEntPOS, &numPOS)) ||
68 			numPOS.m_fFloatp) {
69 			lispMachineCode_SetError (pLM) ;
70 			return	LMR_RETURN ;
71 		}
72 		nPOS	= numPOS.m_Value.m_lLong ;
73 		/*	�Хåե����ɲä��ơ�*/
74 		lispBuffer_AddMarker (pLispMgr, pEntBuffer, pEntMark) ;
75 		/*	�Хåե���ΰ��֤�Ĵ�����롣*/
76 		lispBuffer_PointBufferTop (pLispMgr, pEntBuffer, &nBufferTop) ;
77 		lispBuffer_PointBufferEnd (pLispMgr, pEntBuffer, &nBufferEnd) ;
78 		if (nPOS < nBufferTop)
79 			nPOS	= nBufferTop ;
80 		if (nPOS > nBufferEnd)
81 			nPOS	= nBufferEnd ;
82 		lispMarker_SetBufferPosition (pLispMgr, pEntMark, pEntBuffer, nPOS) ;
83 	}
84 	lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pEntMark) ;
85 	return	LMR_RETURN ;
86 }
87 
88 /*	(mark &optional FORCE)
89  */
90 TLMRESULT
lispMachineState_Mark(register TLispMachine * pLM)91 lispMachineState_Mark (
92 	register TLispMachine*	pLM)
93 {
94 	register TLispManager*	pLispMgr	= pLM->m_pLispMgr ;
95 	TLispEntity*	pEntArglist ;
96 	TLispEntity*	pEntCurBuffer ;
97 	TLispEntity*	pEntMark ;
98 	TLispEntity*	pEntBuffer ;
99 	TLispEntity*	pEntFORCE ;
100 	int				nPos ;
101 	TLispEntity*	pEntRetval ;
102 
103 	assert (pLM      != NULL) ;
104 	assert (pLispMgr != NULL) ;
105 
106 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
107 	assert (pEntArglist != NULL) ;
108 	lispMachineCode_GetCurrentBuffer (pLM, &pEntCurBuffer) ;
109 	assert (pEntCurBuffer != NULL) ;
110 	lispEntity_GetCar     (pLispMgr, pEntArglist, &pEntFORCE) ;
111 	lispBuffer_MarkMarker (pLispMgr, pEntCurBuffer, &pEntMark) ;
112 	assert (pEntMark != NULL) ;
113 	lispMarker_GetBufferPosition (pLispMgr, pEntMark, &pEntBuffer, &nPos) ;
114 	if (pEntBuffer != pEntCurBuffer || nPos < 1) {
115 		/*	inactive */
116 		if (TSUCCEEDED (lispEntity_Nullp (pLispMgr, pEntFORCE))) {
117 			lispMachineCode_SetError (pLM) ;
118 			return	LMR_RETURN ;
119 		}
120 		lispMgr_CreateNil (pLispMgr, &pEntRetval) ;
121 	} else {
122 		/*	active */
123 		if (TFAILED (lispMgr_CreateInteger (pLispMgr, nPos, &pEntRetval)))
124 			return	LMR_ERROR ;
125 	}
126 	lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pEntRetval) ;
127 	return	LMR_RETURN ;
128 }
129 
130 /*	(count-lines START END)
131  */
132 TLMRESULT
lispMachineState_CountLines(register TLispMachine * pLM)133 lispMachineState_CountLines (
134 	register TLispMachine*	pLM)
135 {
136 	register TLispManager*	pLispMgr	= pLM->m_pLispMgr ;
137 	TLispEntity*		pEntArglist ;
138 	TLispEntity*		pEntCurBuffer ;
139 	TLispEntity*		pEntSTART ;
140 	TLispEntity*		pEntEND ;
141 	TLispEntity*		pEntRetval ;
142 	TBufStringMarker	mk ;
143 	register Char		cc ;
144 	TLispNumber			numSTART, numEND ;
145 	register int		nStart, nEnd, nUsage, nLines ;
146 	int					nBufferTop, nBufferEnd, nLength ;
147 
148 	assert (pLM      != NULL) ;
149 	assert (pLispMgr != NULL) ;
150 
151 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
152 	assert (pEntArglist != NULL) ;
153 	lispMachineCode_GetCurrentBuffer (pLM, &pEntCurBuffer) ;
154 	assert (pEntCurBuffer != NULL) ;
155 	if (TFAILED (lispEntity_GetCar  (pLispMgr, pEntArglist, &pEntSTART)) ||
156 		TFAILED (lispEntity_GetCadr (pLispMgr, pEntArglist, &pEntEND)) ||
157 		TFAILED (lispEntity_GetNumberValueOrMarkerPosition (pLispMgr, pEntSTART, &numSTART)) ||
158 		numSTART.m_fFloatp ||
159 		TFAILED (lispEntity_GetNumberValueOrMarkerPosition (pLispMgr, pEntEND,   &numEND)) ||
160 		numEND.m_fFloatp) {
161 		lispMachineCode_SetError (pLM) ;
162 		return	LMR_RETURN ;
163 	}
164 	nStart	= numSTART.m_Value.m_lLong ;
165 	nEnd	= numEND.m_Value.m_lLong ;
166 
167 	lispBuffer_GetFullString  (pLispMgr, pEntCurBuffer, &mk, &nLength) ;
168 	lispBuffer_PointBufferTop (pLispMgr, pEntCurBuffer, &nBufferTop) ;
169 	lispBuffer_PointBufferEnd (pLispMgr, pEntCurBuffer, &nBufferEnd) ;
170 	if (nEnd < nBufferTop || nStart> nEnd || nStart > nBufferEnd) {
171 		lispMachineCode_SetError (pLM) ;
172 		return	LMR_RETURN ;
173 	}
174 
175 	TBufStringMarker_Forward (&mk, nStart - nBufferTop) ;
176 	nUsage	= nEnd - nStart ;
177 	nLines	= 0 ;
178 	while (nUsage -- > 0) {
179 		cc		= TBufStringMarker_GetChar (&mk) ;
180 		TBufStringMarker_Forward (&mk, 1) ;
181 		if (cc == '\n' || cc == '\r')
182 			nLines	++ ;
183 	}
184 	if (TFAILED (lispMgr_CreateInteger (pLispMgr, nLines, &pEntRetval)))
185 		return	LMR_ERROR ;
186 	lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pEntRetval) ;
187 	return	LMR_RETURN ;
188 }
189 
190 /*	(kill-line &optional ARG)
191  *
192  *		���ߤιԤλĤ�� kill ���롣�⤷��blank ���ä��顢newline �� kill
193  *	���롣prefix argument ��������ˤϡ�point ����ʣ���ιԤ� kill ���롣
194  *	negative argument ���ä��顢�������� kill ���롣
195  *
196  *	program �����ɤ����硢nil �ϡְ����ʤ��פ��̣���롣������ prefix
197  *	arg �Ȥ��ƿ����롣
198  */
199 TLMRESULT
lispMachineState_KillLine(register TLispMachine * pLM)200 lispMachineState_KillLine (
201 	register TLispMachine*		pLM)
202 {
203 	register TLispManager*	pLispMgr	= pLM->m_pLispMgr ;
204 	TLispEntity*		pEntArglist ;
205 	TLispEntity*		pEntArg ;
206 	TLispEntity*		pEntBuffer ;
207 	register int		nArg, nOrigin ;
208 	register Char		cc ;
209 	TBufStringMarker	mk, mkOrigin ;
210 	int					nPoint, nPointTop, nPointEnd, nPointMin, nPointMax, nLength ;
211 
212 	assert (pLispMgr != NULL) ;
213 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
214 	assert (pEntArglist != NULL) ;
215 	if (TFAILED (lispEntity_GetCar  (pLispMgr, pEntArglist, &pEntArg))) {
216 		lispMachineCode_SetError (pLM) ;
217 		return	LMR_RETURN ;
218 	}
219 	if (TSUCCEEDED (lispEntity_Nullp (pLispMgr, pEntArg))) {
220 		nArg	= 1 ;
221 	} else {
222 		TLispNumber	numArg ;
223 
224 		if (TFAILED (lispEntity_IntegerOrMarkerp (pLispMgr, pEntArg))) {
225 			lispMachineCode_SetError (pLM) ;
226 			return	LMR_RETURN ;
227 		}
228 		(void) lispEntity_GetNumberValueOrMarkerPosition (pLispMgr, pEntArg, &numArg) ;
229 		nArg	= numArg.m_Value.m_lLong ;
230 	}
231 
232 	lispMachineCode_GetCurrentBuffer (pLM, &pEntBuffer) ;
233 	assert (pEntBuffer != NULL) ;
234 	lispBuffer_GetString (pLispMgr, pEntBuffer, &mk, &nLength) ;
235 	lispBuffer_Point     (pLispMgr, pEntBuffer, &nPoint) ;
236 	lispBuffer_PointBufferTop (pLispMgr, pEntBuffer, &nPointTop) ;
237 	lispBuffer_PointBufferEnd (pLispMgr, pEntBuffer, &nPointEnd) ;
238 	lispBuffer_PointBufferTop (pLispMgr, pEntBuffer, &nPointMin) ;
239 	lispBuffer_PointBufferEnd (pLispMgr, pEntBuffer, &nPointMax) ;
240 	TBufStringMarker_Forward  (&mk, nPoint - nPointTop) ;
241 	mkOrigin	= mk ;
242 	nOrigin		= nPoint ;
243 	if (nArg <= 0) {
244 		do {
245 			while (nPoint > nPointMin) {
246 				TBufStringMarker_Backward (&mk, 1) ;
247 				nPoint	-- ;
248 				cc = TBufStringMarker_GetChar (&mk) ;
249 				if (cc == '\n') {
250 					TBufStringMarker_Forward (&mk, 1) ;
251 					nPoint	++ ;
252 					break ;
253 				}
254 			}
255 			nArg	++ ;
256 		}	while (nArg <= 0) ;
257 
258 	} else {
259 		register int	nTmp ;
260 
261 		do {
262 			while (nPoint < nPointMax) {
263 				TBufStringMarker_Forward (&mk, 1) ;
264 				nPoint	++ ;
265 				cc = TBufStringMarker_GetChar (&mk) ;
266 				if (cc == '\n')
267 					break ;
268 			}
269 			nArg	-- ;
270 		}	while (nArg > 0) ;
271 
272 		nTmp	= nOrigin ;
273 		nOrigin	= nPoint ;
274 		nPoint	= nTmp ;
275 		mk		= mkOrigin ;
276 	}
277 	return	lispMachine_killRegion (pLM, pEntBuffer, &mk, nPoint, nOrigin) ;
278 }
279 
280 /*	(kill-region BEG END)
281  *
282  *	point �� mark �δ֤� kill ���롣������줿 text �� kill ring �������¸
283  *	����롣C-y �Ǥ���������Ф����Ȥ��Ǥ��롣
284  */
285 TLMRESULT
lispMachineState_KillRegion(register TLispMachine * pLM)286 lispMachineState_KillRegion (
287 	register TLispMachine*		pLM)
288 {
289 	register TLispManager*	pLispMgr	= pLM->m_pLispMgr ;
290 	TLispEntity*		pEntArglist ;
291 	TLispEntity*		pEntBuffer ;
292 	TLispEntity*		pEntBegin ;
293 	TLispEntity*		pEntEnd ;
294 	TBufStringMarker	mk ;
295 	int					nPoint, nPointTop, nPointEnd, nPointMin, nPointMax, nLength ;
296 	register int		nBegin, nEnd ;
297 
298 	assert (pLispMgr != NULL) ;
299 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
300 	assert (pEntArglist != NULL) ;
301 	if (TFAILED (lispEntity_GetCar  (pLispMgr, pEntArglist, &pEntBegin)) ||
302 		TFAILED (lispEntity_GetCadr (pLispMgr, pEntArglist, &pEntEnd))) {
303 		lispMachineCode_SetError (pLM) ;
304 		return	LMR_RETURN ;
305 	}
306 	if (TSUCCEEDED (lispEntity_IntegerOrMarkerp (pLispMgr, pEntBegin)) ||
307 		TSUCCEEDED (lispEntity_IntegerOrMarkerp (pLispMgr, pEntEnd))) {
308 		TLispNumber	numBegin, numEnd ;
309 
310 		(void) lispEntity_GetNumberValueOrMarkerPosition (pLispMgr, pEntBegin, &numBegin) ;
311 		(void) lispEntity_GetNumberValueOrMarkerPosition (pLispMgr, pEntEnd,   &numEnd) ;
312 		if (numBegin.m_Value.m_lLong < numEnd.m_Value.m_lLong) {
313 			nBegin	= numBegin.m_Value.m_lLong ;
314 			nEnd	= numEnd.m_Value.m_lLong ;
315 		} else {
316 			nBegin	= numEnd.m_Value.m_lLong ;
317 			nEnd	= numBegin.m_Value.m_lLong ;
318 		}
319 	} else {
320 		/*	number-or-integer-p, XXX */
321 		lispMachineCode_SetError (pLM) ;
322 		return	LMR_RETURN ;
323 	}
324 
325 	lispMachineCode_GetCurrentBuffer (pLM, &pEntBuffer) ;
326 	assert (pEntBuffer != NULL) ;
327 	lispBuffer_GetString (pLispMgr, pEntBuffer, &mk, &nLength) ;
328 	lispBuffer_Point     (pLispMgr, pEntBuffer, &nPoint) ;
329 	lispBuffer_PointBufferTop (pLispMgr, pEntBuffer, &nPointTop) ;
330 	lispBuffer_PointBufferEnd (pLispMgr, pEntBuffer, &nPointEnd) ;
331 	lispBuffer_PointBufferTop (pLispMgr, pEntBuffer, &nPointMin) ;
332 	lispBuffer_PointBufferEnd (pLispMgr, pEntBuffer, &nPointMax) ;
333 	TBufStringMarker_Forward  (&mk, nBegin - nPointTop) ;
334 
335 	if (nBegin < nPointMin || nPointMax < nEnd) {
336 		/*	out-of-range, XXX */
337 		lispMachineCode_SetError (pLM) ;
338 		return	LMR_RETURN ;
339 	}
340 	return	lispMachine_killRegion (pLM, pEntBuffer, &mk, nBegin, nEnd) ;
341 }
342 
343 TLMRESULT
lispMachineState_Yank(register TLispMachine * pLM)344 lispMachineState_Yank (
345 	register TLispMachine*		pLM)
346 {
347 	register TLispManager*	pLispMgr	= pLM->m_pLispMgr ;
348 	TLispEntity*			pEntArglist ;
349 	TLispEntity*			pEntArg ;
350 	TLispEntity*			pEntString ;
351 	TLispEntity*			pEntBuffer ;
352 	register TLispEntity*	pEntMinus ;
353 	const Char*				pString ;
354 	int						nLength, nPoint ;
355 	register int			nArg ;
356 
357 	assert (pLispMgr != NULL) ;
358 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
359 	assert (pEntArglist != NULL) ;
360 	if (TFAILED (lispEntity_GetCar  (pLispMgr, pEntArglist, &pEntArg))) {
361 		lispMachineCode_SetError (pLM) ;
362 		return	LMR_RETURN ;
363 	}
364 	pEntMinus	= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_MINUS) ;
365 	if (TSUCCEEDED (lispEntity_Listp (pLispMgr, pEntArg))) {
366 		nArg	= 0 ;
367 	} else if (TSUCCEEDED (lispEntity_Eq (pLispMgr, pEntArg, pEntMinus))) {
368 		nArg	= -1 ;
369 	} else {
370 		TLispNumber	numArg ;
371 		if (TFAILED (lispEntity_GetNumberValueOrMarkerPosition (pLispMgr, pEntArg, &numArg))) {
372 			lispMachineCode_SetError (pLM) ;
373 			return	LMR_RETURN ;
374 		}
375 		nArg	= numArg.m_Value.m_lLong - 1 ;
376 	}
377 	lispMachineCode_GetCurrentBuffer (pLM, &pEntBuffer) ;
378 	assert (pEntBuffer != NULL) ;
379 	lispBuffer_Point (pLispMgr, pEntBuffer, &nPoint) ;
380 	if (TFAILED (lispMachine_currentKill (pLM, nArg, False, &pEntString)) ||
381 		TFAILED (lispEntity_GetStringValue (pLispMgr, pEntString, &pString, &nLength)) ||
382 		TFAILED (lispBuffer_InsertString (pLispMgr, pEntBuffer, nPoint, pString, nLength))) {
383 		lispMachineCode_SetError (pLM) ;
384 	} else {
385 		register TLispEntity*	pEntYank ;
386 		register TLispEntity*	pEntThisCmd ;
387 		register TLispEntity*	pEntNil ;
388 
389 		/*	������mark �ΰ�ư���ʤ��Ȥ����ʤ�������ɤ�... */
390 
391 		pEntYank	= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_YANK) ;
392 		pEntThisCmd	= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_THIS_COMMAND) ;
393 		lispMachine_SetCurrentSymbolValue (pLM, pEntThisCmd, pEntYank) ;
394 		pEntNil		= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_NIL) ;
395 		lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pEntNil) ;
396 	}
397 	return	LMR_RETURN ;
398 }
399 
400 TLMRESULT
lispMachine_killRegion(register TLispMachine * pLM,register TLispEntity * pEntBuffer,register TBufStringMarker * pMarker,register int nStart,register int nEnd)401 lispMachine_killRegion (
402 	register TLispMachine*		pLM,
403 	register TLispEntity*		pEntBuffer,
404 	register TBufStringMarker*	pMarker,
405 	register int				nStart,
406 	register int				nEnd)
407 {
408 	register TLispManager*	pLispMgr	= pLM->m_pLispMgr ;
409 	TVarbuffer				vbufKilledText ;
410 	register Char*			pbuf ;
411 	register Char			cc ;
412 	register int			nbuf, n ;
413 	static Char				srbuf [256] ;
414 	register TLispEntity*	pEntKillRing ;
415 	register TLispEntity*	pEntKillRegion ;
416 	register TLispEntity*	pEntThisCommand ;
417 	register TLispEntity*	pEntKRYP ;
418 	register TLispEntity*	pEntNil ;
419 	TLispEntity*			pEntLastCommand ;
420 	TLispEntity*			pValLastCommand ;
421 	TLispEntity*			pValKillRing ;
422 	TLispEntity*			pEntKilledText ;
423 	register Boolean		fRetval ;
424 
425 	pEntKillRegion	= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_KILL_REGION) ;
426 
427 	n		= nEnd - nStart ;
428 	if (n <= 0)
429 		goto	exit_func ;
430 
431 	if (TFAILED (TVarbuffer_Initialize (&vbufKilledText, sizeof (Char))))
432 		return	LMR_ERROR ;
433 
434 	pEntKRYP		= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_KILL_RING_YANK_POINTER) ;
435 	pEntKillRing	= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_KILL_RING) ;
436 	lispMachine_GetCurrentSymbolValue (pLM, pEntKillRing, &pValKillRing) ;
437 
438 	pEntLastCommand	= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_LAST_COMMAND) ;
439 	lispMachine_GetCurrentSymbolValue (pLM, pEntLastCommand, &pValLastCommand) ;
440 
441 	/*	ľ���� command �� kill-region �ʤ� append ��ư��ˤʤ롣*/
442 	if (TSUCCEEDED (lispEntity_Eq (pLispMgr, pValLastCommand, pEntKillRegion))) {
443 		TLispEntity*	pEntCar ;
444 		const Char*		pString ;
445 		int				nLength ;
446 
447 		if (TSUCCEEDED (lispEntity_GetCar (pLispMgr, pValKillRing, &pEntCar)) &&
448 			TSUCCEEDED (lispEntity_GetStringValue (pLispMgr, pEntCar, &pString, &nLength))) {
449 			if (TFAILED (TVarbuffer_Add (&vbufKilledText, pString, nLength)))
450 				return	LMR_ERROR ;
451 		}
452 	}
453 
454 	pbuf	= srbuf ;
455 	nbuf	= NELEMENTS (srbuf) ;
456 	while (n > 0) {
457 		cc	= TBufStringMarker_GetChar (pMarker) ;
458 		if (nbuf > 0) {
459 			*pbuf ++	= cc ;
460 			nbuf  -- ;
461 		} else {
462 			if (TFAILED (TVarbuffer_Add (&vbufKilledText, srbuf, NELEMENTS (srbuf))))
463 				return	LMR_ERROR ;
464 			pbuf	= srbuf ;
465 			nbuf	= NELEMENTS (srbuf) ;
466 		}
467 		TBufStringMarker_Forward (pMarker, 1) ;
468 		n	-- ;
469 	}
470 	if (nbuf < NELEMENTS (srbuf)) {
471 		if (TFAILED (TVarbuffer_Add (&vbufKilledText, srbuf, NELEMENTS (srbuf) - nbuf)))
472 			return	LMR_ERROR ;
473 	}
474 
475 	pbuf	= TVarbuffer_GetBuffer (&vbufKilledText) ;
476 	nbuf	= TVarbuffer_GetUsage  (&vbufKilledText) ;
477 	fRetval	= lispMgr_CreateString (pLispMgr, pbuf, nbuf, &pEntKilledText) ;
478 	TVarbuffer_Uninitialize (&vbufKilledText) ;
479 	if (TFAILED (fRetval))
480 		return	LMR_ERROR ;
481 
482 	pEntNil	= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_NIL) ;
483 	if (TFAILED (lispMgr_CreateConscell (pLispMgr, pEntKilledText, pEntNil, &pEntKilledText)))
484 		return	LMR_ERROR ;
485 	lispMachine_SetCurrentSymbolValue (pLM, pEntKillRing, pEntKilledText) ;
486 	lispMachine_SetCurrentSymbolValue (pLM, pEntKRYP,     pEntKilledText) ;
487 
488 	pEntThisCommand	= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_THIS_COMMAND) ;
489 	lispMachine_SetCurrentSymbolValue (pLM, pEntThisCommand, pEntKillRegion) ;
490 
491 	if (TFAILED (lispBuffer_DeleteChar (pLispMgr, pEntBuffer, nStart, nEnd - nStart)))
492 		return	LMR_ERROR ;
493 
494   exit_func:
495 	lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pEntKillRegion) ;
496 	return	LMR_RETURN ;
497 }
498 
499 Boolean
lispMachine_currentKill(register TLispMachine * pLM,register int n,register Boolean fDoNotMove,register TLispEntity ** ppEntRetval)500 lispMachine_currentKill (
501 	register TLispMachine*	pLM,
502 	register int			n,
503 	register Boolean		fDoNotMove,
504 	register TLispEntity**	ppEntRetval)
505 {
506 	register TLispManager*	pLispMgr	= pLM->m_pLispMgr ;
507 	register TLispEntity*	pEntKR ;
508 	register TLispEntity*	pEntKRYP ;
509 	TLispEntity*	pValKR ;
510 	TLispEntity*	pValKRYP ;
511 	int				nLenKR, nLenKRYP ;
512 
513 	pEntKR	= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_KILL_RING) ;
514 	pEntKRYP= lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_KILL_RING_YANK_POINTER) ;
515 	assert (pEntKR != NULL && pEntKRYP != NULL) ;
516 	lispMachine_GetCurrentSymbolValue (pLM, pEntKRYP, &pValKRYP) ;
517 	lispMachine_GetCurrentSymbolValue (pLM, pEntKR,   &pValKR) ;
518 
519 	/*	(nthcdr (mod (- n (length kill-ring-yank-pionter))
520 	 *		 	(length kill-ring))
521 	 *			kill-ring)
522 	 */
523 	if (TFAILED (lispEntity_GetLength (pLispMgr, pValKRYP, &nLenKRYP)) ||
524 		TFAILED (lispEntity_GetLength (pLispMgr, pValKRYP, &nLenKR)))
525 		return	FALSE ;
526 	if (nLenKR == 0)
527 		return	FALSE ;
528 
529 	n	= ((n - nLenKRYP) % nLenKR) ;
530 	while (n > 0 && TFAILED (lispEntity_Nullp (pLispMgr, pValKR))) {
531 		if (TFAILED (lispEntity_GetCdr (pLispMgr, pValKR, &pValKR)))
532 			return	FALSE ;
533 		n	-- ;
534 	}
535 
536 	if (! fDoNotMove)
537 		lispMachine_SetCurrentSymbolValue (pLM, pEntKRYP, pValKR) ;
538 	lispEntity_GetCar (pLispMgr, pValKR, ppEntRetval) ;
539 	return	TRUE ;
540 }
541 
542 
543