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 "regex.h"
26
27 static TLMRESULT lispMachine_search (TLispMachine*, Boolean (*)(TLispMachine*, TLispEntity*, const Char*, int, int, int), int) ;
28
29 /*
30 * string-match is a built-in function.
31 * (string-match REGEXP STRING &optional START)
32 *
33 * Return index of start of first match for REGEXP in STRING, or nil.
34 * Case is ignored if `case-fold-search' is non-nil in the current buffer.
35 * If third arg START is non-nil, start search at that index in STRING.
36 * For index of first char beyond the match, do (match-end 0).
37 * `match-end' and `match-beginning' also give indices of substrings
38 * matched by parenthesis constructs in the pattern.
39 */
40 TLMRESULT
lispMachineState_StringMatch(register TLispMachine * pLM)41 lispMachineState_StringMatch (
42 register TLispMachine* pLM)
43 {
44 register TLispManager* pLispMgr ;
45 TLispEntity* pEntArglist ;
46 TLispEntity* pEntREGEXP ;
47 TLispEntity* pEntSTRING ;
48 TLispEntity* pEntSTART ;
49 TLispEntity* pEntRetval ;
50 const Char* pStrREGEXP ;
51 int nStrREGEXP ;
52 const Char* pStrSTRING ;
53 int nStrSTRING ;
54 long lStart ;
55
56 assert (pLM != NULL) ;
57 pLispMgr = pLM->m_pLispMgr ;
58 assert (pLispMgr != NULL) ;
59 lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
60 if (TFAILED (lispEntity_GetCar (pLispMgr, pEntArglist, &pEntREGEXP)) ||
61 TFAILED (lispEntity_Stringp (pLispMgr, pEntREGEXP)) ||
62 TFAILED (lispEntity_GetCdr (pLispMgr, pEntArglist, &pEntArglist)) ||
63 TFAILED (lispEntity_GetCar (pLispMgr, pEntArglist, &pEntSTRING)) ||
64 TFAILED (lispEntity_Stringp (pLispMgr, pEntSTRING)) ||
65 TFAILED (lispEntity_GetCadr (pLispMgr, pEntArglist, &pEntSTART))) {
66 lispMachineCode_SetError (pLM) ;
67 return LMR_RETURN ;
68 }
69 lispEntity_GetStringValue (pLispMgr, pEntREGEXP, &pStrREGEXP, &nStrREGEXP) ;
70 lispEntity_GetStringValue (pLispMgr, pEntSTRING, &pStrSTRING, &nStrSTRING) ;
71 if (TFAILED (lispEntity_GetIntegerValue (pLispMgr, pEntSTART, &lStart)))
72 lStart = 0 ;
73 if (lStart > nStrSTRING) {
74 lispMachineCode_SetError (pLM) ;
75 return LMR_RETURN ;
76 }
77 lispMachineCode_SetRegmatchTarget (pLM, pEntSTRING) ;
78 if (TFAILED (lispMachineCode_StringMatch (pLM, pStrREGEXP, nStrREGEXP, pStrSTRING, nStrSTRING, lStart))) {
79 lispMgr_CreateNil (pLispMgr, &pEntRetval) ;
80 } else {
81 int nPosition ;
82 lispMachineCode_MatchBeginning (pLM, 0, &nPosition) ;
83 lispMgr_CreateInteger (pLispMgr, nPosition, &pEntRetval) ;
84 }
85 lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pEntRetval) ;
86 return LMR_RETURN ;
87 }
88
89 /*
90 * re-search-forward is an interactive built-in function.
91 * (re-search-forward REGEXP &optional BOUND NOERROR COUNT)
92 *
93 * Search forward from point for regular expression REGEXP.
94 * Set point to the end of the occurrence found, and return point.
95 * An optional second argument bounds the search; it is a buffer position.
96 * The match found must not extend after that position.
97 * Optional third argument, if t, means if fail just return nil (no error).
98 * If not nil and not t, move to limit of search and return nil.
99 * Optional fourth argument is repeat count--search for successive occurrences.
100 * See also the functions `match-beginning', `match-end', `match-string',
101 * and `replace-match'.
102 */
103 TLMRESULT
lispMachineState_ReSearchForward(register TLispMachine * pLM)104 lispMachineState_ReSearchForward (
105 register TLispMachine* pLM)
106 {
107 return lispMachine_search (pLM, &lispMachineCode_ReSearchForward, 1) ;
108 }
109
110 TLMRESULT
lispMachineState_ReSearchBackward(register TLispMachine * pLM)111 lispMachineState_ReSearchBackward (
112 register TLispMachine* pLM)
113 {
114 return lispMachine_search (pLM, &lispMachineCode_ReSearchBackward, - 1) ;
115 }
116
117 /*
118 * match-beginning is a built-in function.
119 * (match-beginning SUBEXP)
120 *
121 * �Ǹ�� search �ˤ�äƥޥå������ƥ����Ȥκǽ�ΰ��֤��֤���
122 * Return position of start of text matched by last search.
123 * SUBEXP, a number, specifies which parenthesized expression in the last
124 * regexp.
125 * Value is nil if SUBEXPth pair didn't match, or there were less than
126 * SUBEXP pairs.
127 * Zero means the entire text matched by the whole regexp or whole string.
128 */
129 TLMRESULT
lispMachineState_MatchBeginning(register TLispMachine * pLM)130 lispMachineState_MatchBeginning (
131 register TLispMachine* pLM)
132 {
133 register TLispManager* pLispMgr ;
134 TLispEntity* pEntArglist ;
135 TLispEntity* pEntSUBEXP ;
136 TLispEntity* pEntRetval ;
137 long lNumber ;
138 int nPosition ;
139
140 assert (pLM != NULL) ;
141 pLispMgr = pLM->m_pLispMgr ;
142 assert (pLispMgr != NULL) ;
143 lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
144 if (TFAILED (lispEntity_GetCar (pLispMgr, pEntArglist, &pEntSUBEXP)) ||
145 TFAILED (lispEntity_GetIntegerValue (pLispMgr, pEntSUBEXP, &lNumber))) {
146 lispMachineCode_SetError (pLM) ;
147 return LMR_RETURN ;
148 }
149 if (TFAILED (lispMachineCode_MatchBeginning (pLM, lNumber, &nPosition))) {
150 lispMgr_CreateNil (pLispMgr, &pEntRetval) ;
151 } else {
152 lispMgr_CreateInteger (pLispMgr, nPosition, &pEntRetval) ;
153 }
154 lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pEntRetval) ;
155 return LMR_RETURN ;
156 }
157
158 /*
159 * match-end is a built-in function.
160 * (match-end SUBEXP)
161 *
162 * Return position of end of text matched by last search.
163 * SUBEXP, a number, specifies which parenthesized expression in the last
164 * regexp.
165 * Value is nil if SUBEXPth pair didn't match, or there were less than
166 * SUBEXP pairs.
167 * Zero means the entire text matched by the whole regexp or whole string.
168 */
169 TLMRESULT
lispMachineState_MatchEnd(register TLispMachine * pLM)170 lispMachineState_MatchEnd (
171 register TLispMachine* pLM)
172 {
173 register TLispManager* pLispMgr ;
174 TLispEntity* pEntArglist ;
175 TLispEntity* pEntSUBEXP ;
176 TLispEntity* pEntRetval ;
177 long lNumber ;
178 int nPosition ;
179
180 assert (pLM != NULL) ;
181 pLispMgr = pLM->m_pLispMgr ;
182 assert (pLispMgr != NULL) ;
183 lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
184 if (TFAILED (lispEntity_GetCar (pLispMgr, pEntArglist, &pEntSUBEXP)) ||
185 TFAILED (lispEntity_GetIntegerValue (pLispMgr, pEntSUBEXP, &lNumber))) {
186 lispMachineCode_SetError (pLM) ;
187 return LMR_RETURN ;
188 }
189 if (TFAILED (lispMachineCode_MatchEnd (pLM, lNumber, &nPosition))) {
190 lispMgr_CreateNil (pLispMgr, &pEntRetval) ;
191 } else {
192 lispMgr_CreateInteger (pLispMgr, nPosition, &pEntRetval) ;
193 }
194 lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pEntRetval) ;
195 return LMR_RETURN ;
196 }
197
198 /*
199 * match-data is a built-in function.
200 * (match-data &optional INTEGERS REUSE)
201 *
202 * Return a list containing all info on what the last search matched.
203 * Element 2N is `(match-beginning N)'; element 2N + 1 is `(match-end N)'.
204 * All the elements are markers or nil (nil if the Nth pair didn't match)
205 * if the last match was on a buffer; integers or nil if a string was matched.
206 * Use `store-match-data' to reinstate the data in this list.
207 *
208 * If INTEGERS (the optional first argument) is non-nil, always use integers
209 * (rather than markers) to represent buffer positions.
210 * If REUSE is a list, reuse it as part of the value. If REUSE is long enough
211 * to hold all the values, and if INTEGERS is non-nil, no consing is done.
212 */
213 TLMRESULT
lispMachineState_MatchData(register TLispMachine * pLM)214 lispMachineState_MatchData (
215 register TLispMachine* pLM)
216 {
217 register TLispManager* pLispMgr ;
218 TLispEntity* pEntArglist ;
219 TLispEntity* pEntINTEGERS ;
220 TLispEntity* pEntREUSE ;
221 TLispEntity* pEntNode ;
222 register TLispEntity* pEntNil ;
223 register TLispEntity* pEntBuffer = NULL ;
224 TLispConscell conslst ;
225 register int i ;
226 register regmatch_t* pMatch ;
227 register Boolean fInteger ;
228
229 assert (pLM != NULL) ;
230 pLispMgr = pLM->m_pLispMgr ;
231 assert (pLispMgr != NULL) ;
232 lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
233 if (TFAILED (lispEntity_GetCar (pLispMgr, pEntArglist, &pEntINTEGERS)) ||
234 TFAILED (lispEntity_GetCadr (pLispMgr, pEntArglist, &pEntREUSE))) {
235 lispMachineCode_SetError (pLM) ;
236 return LMR_RETURN ;
237 }
238 fInteger = lispEntity_Nullp (pLispMgr, pEntINTEGERS) ;
239 if (!fInteger &&
240 pLM->m_pEntRegMatch != NULL &&
241 TSUCCEEDED (lispEntity_Bufferp (pLispMgr, pLM->m_pEntRegMatch))) {
242 pEntBuffer = pLM->m_pEntRegMatch ;
243 } else {
244 fInteger = True ;
245 }
246
247 pEntNil = lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_NIL) ;
248 conslst.m_pCar = conslst.m_pCdr = NULL ;
249 pMatch = pLM->m_aRegMatch ;
250 for (i = 0 ; i < MAX_REGEXP_MATCHES ; i ++, pMatch ++) {
251 if (pMatch->rm_so < 0)
252 break ;
253 if (fInteger) {
254 if (TFAILED (lispMgr_CreateInteger (pLispMgr, (long) pMatch->rm_so, &pEntNode)))
255 return LMR_ERROR ;
256 lispEntity_Push2List (pLispMgr, &conslst, pEntNode) ;
257 if (TFAILED (lispMgr_CreateInteger (pLispMgr, (long) pMatch->rm_eo, &pEntNode)))
258 return LMR_ERROR ;
259 lispEntity_Push2List (pLispMgr, &conslst, pEntNode) ;
260 } else {
261 if (TFAILED (lispMgr_CreateMarker (pLispMgr, &pEntNode)))
262 return LMR_ERROR ;
263 lispEntity_Push2List (pLispMgr, &conslst, pEntNode) ;
264 lispBuffer_AddMarker (pLispMgr, pEntBuffer, pEntNode) ;
265 lispMarker_SetBufferPosition (pLispMgr, pEntNode, pEntBuffer, pMatch->rm_so) ;
266 if (TFAILED (lispMgr_CreateMarker (pLispMgr, &pEntNode)))
267 return LMR_ERROR ;
268 lispEntity_Push2List (pLispMgr, &conslst, pEntNode) ;
269 lispBuffer_AddMarker (pLispMgr, pEntBuffer, pEntNode) ;
270 lispMarker_SetBufferPosition (pLispMgr, pEntNode, pEntBuffer, pMatch->rm_eo) ;
271 }
272 }
273 if (! fInteger) {
274 while (i < MAX_REGEXP_MATCHES) {
275 lispEntity_Push2List (pLispMgr, &conslst, pEntNil) ;
276 lispEntity_Push2List (pLispMgr, &conslst, pEntNil) ;
277 i ++ ;
278 }
279 }
280 if (conslst.m_pCar != NULL) {
281 lispMachineCode_SetLReg (pLM, LM_LREG_ACC, conslst.m_pCar) ;
282 lispEntity_Release (pLispMgr, conslst.m_pCar) ;
283 conslst.m_pCar = NULL ;
284 } else {
285 lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pEntNil) ;
286 }
287 return LMR_RETURN ;
288 }
289
290 /* (set-match-data LIST)
291 *
292 * Set internal data on last search match from elements of LIST.
293 * LIST should have been created by calling `match-data' previously.
294 */
295 TLMRESULT
lispMachineState_SetMatchData(register TLispMachine * pLM)296 lispMachineState_SetMatchData (
297 register TLispMachine* pLM)
298 {
299 register TLispManager* pLispMgr ;
300 TLispEntity* pEntArglist ;
301 TLispEntity* pEntLIST ;
302 TLispEntity* pEntBuffer = NULL ;
303 register TLispEntity* pEntNil ;
304 register int nMatch ;
305 register regmatch_t* pMatch ;
306
307 assert (pLM != NULL) ;
308 pLispMgr = pLM->m_pLispMgr ;
309 assert (pLispMgr != NULL) ;
310 lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
311 if (TFAILED (lispEntity_GetCar (pLispMgr, pEntArglist, &pEntLIST)) ||
312 TFAILED (lispEntity_Listp (pLispMgr, pEntLIST))) {
313 lispMachineCode_SetError (pLM) ;
314 return LMR_RETURN ;
315 }
316
317 pEntNil = lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_NIL) ;
318 pMatch = pLM->m_aRegMatch ;
319 nMatch = 0 ;
320 while (nMatch < MAX_REGEXP_MATCHES && TFAILED (lispEntity_Nullp (pLispMgr, pEntLIST))) {
321 TLispEntity* pEntSO ;
322 TLispEntity* pEntEO ;
323 TLispNumber num ;
324
325 if (TFAILED (lispEntity_GetCar (pLispMgr, pEntLIST, &pEntSO)) ||
326 TFAILED (lispEntity_GetCdr (pLispMgr, pEntLIST, &pEntLIST)) ||
327 TFAILED (lispEntity_GetCar (pLispMgr, pEntLIST, &pEntEO)) ||
328 TFAILED (lispEntity_GetCdr (pLispMgr, pEntLIST, &pEntLIST))) {
329 lispMachineCode_SetError (pLM) ;
330 return LMR_RETURN ;
331 }
332 if (pEntBuffer == NULL &&
333 TSUCCEEDED (lispEntity_Markerp (pLispMgr, pEntSO))) {
334 int nPosition ;
335 (void) lispMarker_GetBufferPosition (pLispMgr, pEntSO, &pEntBuffer, &nPosition) ;
336 }
337 if (TFAILED (lispEntity_GetNumberOrMarkerValue (pLispMgr, pEntSO, &num))) {
338 pMatch->rm_so = -1 ;
339 } else {
340 pMatch->rm_so = (num.m_fFloatp)? -1 : num.m_Value.m_lLong ;
341 }
342 if (TFAILED (lispEntity_GetNumberOrMarkerValue (pLispMgr, pEntEO, &num))) {
343 pMatch->rm_eo = -1 ;
344 } else {
345 pMatch->rm_eo = (num.m_fFloatp)? -1 : num.m_Value.m_lLong ;
346 }
347 pMatch ++ ;
348 nMatch ++ ;
349 }
350 while (nMatch < MAX_REGEXP_MATCHES) {
351 pMatch->rm_so = pMatch->rm_eo = -1 ;
352 pMatch ++ ;
353 nMatch ++ ;
354 }
355 lispMachineCode_SetRegmatchTarget (pLM, pEntBuffer) ;
356 lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pEntNil) ;
357 return LMR_RETURN ;
358 }
359
360 /* search-forward is an interactive built-in function.
361 * (search-forward STRING &optional BOUND NOERROR COUNT)
362 *
363 * Search forward from point for STRING.
364 * Set point to the end of the occurrence found, and return point.
365 * An optional second argument bounds the search; it is a buffer position.
366 * The match found must not extend after that position. nil is equivalent
367 * to (point-max).
368 * Optional third argument, if t, means if fail just return nil (no error).
369 * If not nil and not t, move to limit of search and return nil.
370 * Optional fourth argument is repeat count--search for successive occurrences.
371 *
372 * Search case-sensitivity is determined by the value of the variable
373 * `case-fold-search', which see.
374 *
375 * See also the functions `match-beginning', `match-end' and `replace-match'.
376 */
377 TLMRESULT
lispMachineState_SearchForward(register TLispMachine * pLM)378 lispMachineState_SearchForward (
379 register TLispMachine* pLM)
380 {
381 return lispMachine_search (pLM, &lispMachineCode_SearchForward, 1) ;
382 }
383
384 /*
385 */
386 TLMRESULT
lispMachineState_SearchBackward(register TLispMachine * pLM)387 lispMachineState_SearchBackward (
388 register TLispMachine* pLM)
389 {
390 return lispMachine_search (pLM, &lispMachineCode_SearchBackward, - 1) ;
391 }
392
393 /* built-in function:
394 * (regexp-quote STRING)
395 *
396 * STRING �����Τ˥ޥå����Ƥ���¾�ˤϥޥå����ʤ�����ɽ��ʸ������֤���
397 *
398 * �Ĥޤ�ϡ�[] �� *, ., ? �ʤɤδ�ʤ�ʸ����� quote ����Ȥ������Ȥʤ�
399 * ������ TCL/TK ������ä���ơ������ä� regex library ������ʸ���äƲ�
400 * ���ä����ʡ�emacs �Ȥ� quote �δط����դ��ä��褦�ʡ�
401 *
402 * �Τǡ�TCL/TK �ǤΤ����Ѥ��Ƥ���ط��塢"[", "?" �ʤɤ�ɬ������ä���
403 * �Ȥ�����Ȥ�ɬ�ס��ȡ�
404 */
405 TLMRESULT
lispMachineState_RegexpQuote(register TLispMachine * pLM)406 lispMachineState_RegexpQuote (
407 register TLispMachine* pLM)
408 {
409 register TLispManager* pLispMgr = pLM->m_pLispMgr ;
410 TVarbuffer vbufSTRING ;
411 static const char rchQuoteChars [] = ".*+?^$()\\[]{}|" ;
412 static const Char chQuote = '\\' ;
413 register TLMRESULT nResult = LMR_ERROR ;
414 TLispEntity* pEntArglist ;
415 TLispEntity* pEntSTRING ;
416 const Char* pStrSTRING ;
417 int nStrSTRING ;
418 register const Char* pStrHEAD ;
419 register const Char* pStrResult ;
420 register int nStrResult ;
421 TLispEntity* pEntRetval ;
422
423 assert (pLM != NULL) ;
424 assert (pLispMgr != NULL) ;
425
426 if (TFAILED (TVarbuffer_Initialize (&vbufSTRING, sizeof (Char))))
427 return LMR_ERROR ;
428 lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
429 lispEntity_GetCar (pLispMgr, pEntArglist, &pEntSTRING) ;
430 if (TFAILED (lispEntity_GetStringValue (pLispMgr, pEntSTRING, &pStrSTRING, &nStrSTRING))) {
431 lispMachineCode_SetError (pLM) ;
432 goto error ;
433 }
434 /* ".*+?^$()\\[]{}|" �ȡ������� quote ���롣*/
435 while (nStrSTRING > 0) {
436 pStrHEAD = pStrSTRING ;
437 while (nStrSTRING > 0 &&
438 (!Char_IsAscii (*pStrSTRING) ||
439 memchr (rchQuoteChars, (char)*pStrSTRING, NELEMENTS(rchQuoteChars)) == NULL)) {
440 pStrSTRING ++ ;
441 nStrSTRING -- ;
442 }
443 if (pStrHEAD < pStrSTRING)
444 if (TFAILED (TVarbuffer_Add (&vbufSTRING, pStrHEAD, pStrSTRING - pStrHEAD)))
445 goto error ;
446 if (nStrSTRING > 0) {
447 if (TFAILED (TVarbuffer_Add (&vbufSTRING, &chQuote, 1)) ||
448 TFAILED (TVarbuffer_Add (&vbufSTRING, pStrSTRING, 1)))
449 goto error ;
450 pStrSTRING ++ ;
451 nStrSTRING -- ;
452 }
453 }
454 pStrResult = TVarbuffer_GetBuffer (&vbufSTRING) ;
455 nStrResult = TVarbuffer_GetUsage (&vbufSTRING) ;
456 if (TFAILED (lispMgr_CreateString (pLispMgr, pStrResult, nStrResult, &pEntRetval)))
457 goto error ;
458 lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pEntRetval) ;
459 nResult = LMR_RETURN ;
460 error:
461 TVarbuffer_Uninitialize (&vbufSTRING) ;
462 return nResult ;
463 }
464
465 /*========================================================================
466 * private functions
467 */
468 TLMRESULT
lispMachine_search(register TLispMachine * pLM,register Boolean (* pCmd)(TLispMachine *,TLispEntity *,const Char *,int,int,int),register int nDir)469 lispMachine_search (
470 register TLispMachine* pLM,
471 register Boolean (*pCmd)(TLispMachine*, TLispEntity*, const Char*, int, int, int),
472 register int nDir)
473 {
474 register TLispManager* pLispMgr ;
475 TLispEntity* pEntBuffer ;
476 TLispEntity* pEntArglist ;
477 TLispEntity* pEntSTRING ;
478 TLispEntity* pEntBOUND ;
479 TLispEntity* pEntNOERROR ;
480 TLispEntity* pEntCOUNT ;
481 const Char* pStrSTRING ;
482 int nStrSTRING ;
483 int nCOUNT, nBOUND ;
484 TLispEntity* pEntRetval ;
485
486 assert (pLM != NULL) ;
487 assert (pCmd != NULL) ;
488 pLispMgr = pLM->m_pLispMgr ;
489 assert (pLispMgr != NULL) ;
490 lispMachineCode_GetCurrentBuffer (pLM, &pEntBuffer) ;
491 assert (pEntBuffer != NULL) ;
492 lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
493 assert (pEntArglist != NULL) ;
494
495 lispEntity_GetCar (pLispMgr, pEntArglist, &pEntSTRING) ;
496 if (TFAILED (lispEntity_GetStringValue (pLispMgr, pEntSTRING, &pStrSTRING, &nStrSTRING)))
497 goto error ;
498 lispEntity_GetCdr (pLispMgr, pEntArglist, &pEntArglist) ;
499
500 /* default �� bound �� point-max/min �Ǥ��뤬�����̤˻��ꤵ��Ƥ�����Ϥ���
501 * �¤�ǤϤʤ���*/
502 lispEntity_GetCar (pLispMgr, pEntArglist, &pEntBOUND) ;
503 if (nDir > 0) {
504 lispBuffer_PointMax (pLispMgr, pEntBuffer, &nBOUND) ;
505 } else {
506 lispBuffer_PointMin (pLispMgr, pEntBuffer, &nBOUND) ;
507 }
508 if (TFAILED (lispEntity_Nullp (pLispMgr, pEntBOUND))) {
509 TLispNumber numBOUND ;
510 if (TFAILED (lispEntity_GetNumberOrMarkerValue (pLispMgr, pEntBOUND, &numBOUND)) ||
511 numBOUND.m_fFloatp)
512 goto error ;
513 nBOUND = numBOUND.m_Value.m_lLong ;
514 }
515 lispEntity_GetCdr (pLispMgr, pEntArglist, &pEntArglist) ;
516 lispEntity_GetCar (pLispMgr, pEntArglist, &pEntNOERROR) ;
517
518 /* �����η����֤������ default �Ǥϰ��Ǥ��롣*/
519 nCOUNT = 1 ;
520 lispEntity_GetCadr (pLispMgr, pEntArglist, &pEntCOUNT) ;
521 if (TFAILED (lispEntity_Nullp (pLispMgr, pEntCOUNT))) {
522 long lCOUNT ;
523 if (TFAILED (lispEntity_GetIntegerValue (pLispMgr, pEntCOUNT, &lCOUNT)))
524 goto error ;
525 nCOUNT = lCOUNT ;
526 }
527 lispMachineCode_SetRegmatchTarget (pLM, pEntBuffer) ;
528 if (TFAILED ((*pCmd) (pLM, pEntBuffer, pStrSTRING, nStrSTRING, nBOUND, nCOUNT))) {
529 if (TSUCCEEDED (lispEntity_Nullp (pLispMgr, pEntNOERROR)))
530 goto error ;
531 lispMgr_CreateNil (pLispMgr, &pEntRetval) ;
532 if (TFAILED (lispEntity_Tp (pLispMgr, pEntNOERROR))) {
533 /* �ɤ�����٤��ʤΤ��� ������ɬ�פϤ���Τ��� */
534 }
535 } else {
536 TLispEntity* pEntPoint ;
537 int nPosition ;
538
539 if (nDir > 0) {
540 (void) lispMachineCode_MatchEnd (pLM, 0, &nPosition) ;
541 } else {
542 (void) lispMachineCode_MatchBeginning (pLM, 0, &nPosition) ;
543 }
544 if (TFAILED (lispMgr_CreateInteger (pLispMgr, nPosition, &pEntRetval)))
545 return LMR_ERROR ;
546
547 /* backward �����ξ��ˤϡ�position �� beginning �ΰ��֤ˤʤ롣
548 * forward �����ξ��ˤϡ�position �� end �ΰ��֤ˤʤ롣
549 */
550 lispBuffer_PointMarker (pLispMgr, pEntBuffer, &pEntPoint) ;
551 lispMarker_SetBufferPosition (pLispMgr, pEntPoint, pEntBuffer, nPosition) ;
552 }
553 lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pEntRetval) ;
554 return LMR_RETURN ;
555
556 error:
557 lispMachineCode_SetError (pLM) ;
558 return LMR_RETURN ;
559 }
560
561