1 /* Copyright 1992 NEC Corporation, Tokyo, Japan.
2 *
3 * Permission to use, copy, modify, distribute and sell this software
4 * and its documentation for any purpose is hereby granted without
5 * fee, provided that the above copyright notice appear in all copies
6 * and that both that copyright notice and this permission notice
7 * appear in supporting documentation, and that the name of NEC
8 * Corporation not be used in advertising or publicity pertaining to
9 * distribution of the software without specific, written prior
10 * permission. NEC Corporation makes no representations about the
11 * suitability of this software for any purpose. It is provided "as
12 * is" without express or implied warranty.
13 *
14 * NEC CORPORATION DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
15 * INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN
16 * NO EVENT SHALL NEC CORPORATION BE LIABLE FOR ANY SPECIAL, INDIRECT OR
17 * CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
18 * USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
19 * OTHER TORTUOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
20 * PERFORMANCE OF THIS SOFTWARE.
21 */
22
23 #if !defined(lint) && !defined(__CODECENTER__)
24 static char rcsid[] = "$Id: lisp.c,v 1.11.2.1 2004/04/26 22:49:21 aida_s Exp $";
25 #endif
26
27 /*
28 ** main program of lisp
29 */
30 #include "lisp.h"
31 #include "patchlevel.h"
32
33 #include <signal.h>
34
35 static FILE *outstream = (FILE *)0;
36
37 static char *celltop, *cellbtm, *freecell;
38 static char *memtop;
39
40 static int ncells = CELLSIZE;
41
42 static initIS();
43 static void finIS();
44 static allocarea(), skipspaces(), zaplin(), isterm();
45 static void prins();
46 static list mkatm(), read1(), ratom(), ratom2(), rstring();
47 static int tyipeek(), tyi();
48 static void tyo pro((int));
49 static void defatms(), epush();
50 static void push(), pop();
51 static int evpsh();
52 static void freearea(), print();
53 static list getatm(), getatmz(), newsymbol(), copystring();
54 static list assq(), pop1();
55 static list Lprogn(), Lcons(), Lread();
56 static list Leval(), Lprint(), Lmodestr(), Lputd(), Lxcons(), Lncons();
57 static list NumAcc(), StrAcc();
58
59 /* parameter stack */
60
61 static list *stack, *sp;
62
63 /* environment stack */
64
65 static list *estack, *esp;
66
67 /* oblist */
68
69 static list *oblist; /* oblist hashing array */
70
71 #define LISPERROR -1
72
73 typedef struct {
74 FILE *f;
75 char *name;
76 unsigned line;
77 } lispfile;
78
79 static lispfile *files;
80 static int filep;
81
82 /* lisp read buffer & read pointer */
83
84 static char *readbuf; /* read buffer */
85 static char *readptr; /* read pointer */
86
87 /* error functions */
88
89 static void argnerr(), numerr(), error();
90
91 /* multiple values */
92
93 #define MAXVALUES 16
94 static list *values; /* multiple values here */
95 static int valuec; /* number of values here */
96
97 /* symbols */
98
99 static list QUOTE, T, _LAMBDA, _MACRO, COND, USER;
100 static list BUSHU, GRAMMAR, RENGO, KATAKANA, HIRAGANA, HYPHEN;
101
102 #include <setjmp.h>
103
104 static struct lispcenv {
105 jmp_buf jmp_env;
106 int base_stack;
107 int base_estack;
108 } *env; /* environment for setjmp & longjmp */
109 static int jmpenvp = MAX_DEPTH;
110
111 static jmp_buf fatal_env;
112
113 /* external functions
114
115 �����ؿ��ϰʲ��Σ���
116
117 (1) clisp_init() -- �������ޥ����ե�������ɤि��ν�������
118
119 lisp �ν������Ԥ�ɬ�פʥ���� allocate ���롣
120
121 (2) clisp_fin() -- �������ޥ����ɤ߹����Ѥ��ΰ��������롣
122
123 �嵭�ν���������������������롣
124
125 (3) YYparse_by_rcfilename((char *)s) -- �������ޥ����ե�������ɤ߹��ࡣ
126
127 s �ǻ��ꤵ�줿�ե�����̾�Υ������ޥ����ե�������ɤ߹���ǥ�����
128 �ޥ����������Ԥ����ե����뤬¸�ߤ���� 1 ���֤������Ǥʤ����
129 0 ���֤���
130
131 */
132
133 #ifdef __STDC__
134 static list getatmz(char *);
135 #else
136 static list getatmz();
137 #endif
138
139 /*********************************************************************
140 * wchar_t replace begin *
141 *********************************************************************/
142 #ifdef wchar_t
143 # error "wchar_t is already defined"
144 #endif
145 #define wchar_t cannawc
146
147
148 int
clisp_init()149 clisp_init()
150 {
151 int i;
152
153 if ( !allocarea() ) {
154 return 0;
155 }
156
157 if ( !initIS() ) {
158 freearea();
159 return 0;
160 }
161
162 /* stack pointer initialization */
163 sp = stack + STKSIZE;
164 esp = estack + STKSIZE;
165 epush(NIL);
166
167 /* initialize read pointer */
168 readptr = readbuf;
169 *readptr = '\0';
170 files[filep = 0].f = stdin;
171 files[filep].name = (char *)0;
172 files[filep].line = 0;
173
174 /* oblist initialization */
175 for (i = 0; i < BUFSIZE ; i++)
176 oblist[i] = 0;
177
178 /* symbol definitions */
179 defatms();
180 return 1;
181 }
182
183 #ifndef NO_EXTEND_MENU
184 static void
fillMenuEntry()185 fillMenuEntry()
186 {
187 extern extraFunc *FindExtraFunc(), *extrafuncp;
188 extraFunc *p, *fp;
189 int i, n, fid;
190 menuitem *mb;
191
192 for (p = extrafuncp ; p ; p = p->next) {
193 if (p->keyword == EXTRA_FUNC_DEFMENU) {
194 n = p->u.menuptr->nentries;
195 mb = p->u.menuptr->body;
196 for (i = 0 ; i < n ; i++, mb++) {
197 if (mb->flag == MENU_SUSPEND) {
198 list l = (list)mb->u.misc;
199 fid = symbolpointer(l)->fid;
200 if (fid < CANNA_FN_MAX_FUNC) {
201 goto just_a_func;
202 }
203 else {
204 fp = FindExtraFunc(fid);
205 if (fp && fp->keyword == EXTRA_FUNC_DEFMENU) {
206 mb->u.menu_next = fp->u.menuptr;
207 mb->flag = MENU_MENU;
208 }
209 else {
210 just_a_func:
211 mb->u.fnum = fid;
212 mb->flag = MENU_FUNC;
213 }
214 }
215 }
216 }
217 }
218 }
219 }
220 #endif /* NO_EXTEND_MENU */
221
222 #define UNTYIUNIT 32
223 static char *untyibuf = 0;
224 static int untyisize = 0, untyip = 0;
225
226 void
clisp_fin()227 clisp_fin()
228 {
229 #ifndef NO_EXTEND_MENU
230 /* ����������äơ�menu ��Ϣ�Υǡ��������� */
231 fillMenuEntry();
232 #endif
233
234 finIS();
235
236 while (filep >= 0) {
237 if (files[filep].f && files[filep].f != stdin) {
238 fclose(files[filep].f);
239 }
240 if (files[filep].name) {
241 free(files[filep].name);
242 }
243 filep--;
244 }
245
246 freearea();
247 if (untyisize) {
248 free(untyibuf);
249 untyisize = 0;
250 untyibuf = (char *)0;
251 }
252 }
253
254 int
YYparse_by_rcfilename(s)255 YYparse_by_rcfilename(s)
256 char *s;
257 {
258 extern ckverbose;
259 int retval = 0;
260 FILE *f;
261 FILE *saved_outstream;
262
263 if (setjmp(fatal_env)) {
264 retval = 0;
265 goto quit_parse_rcfile;
266 }
267
268 if (jmpenvp <= 0) { /* �Ƶ������������� */
269 return 0;
270 }
271 jmpenvp--;
272
273 if (ckverbose >= CANNA_HALF_VERBOSE) {
274 saved_outstream = outstream;
275 outstream = stdout;
276 }
277
278 f = fopen(s, "r");
279 if (f) {
280 if (ckverbose == CANNA_FULL_VERBOSE) {
281 printf("�������ޥ����ե�����Ȥ��� \"%s\" ���Ѥ��ޤ���\n", s);
282 }
283 files[++filep].f = f;
284 files[filep].name = malloc(strlen(s) + 1);
285 if (files[filep].name) {
286 strcpy(files[filep].name, s);
287 }
288 else {
289 filep--;
290 fclose(f);
291 goto quit_parse_rcfile;
292 }
293 files[filep].line = 0;
294
295 setjmp(env[jmpenvp].jmp_env);
296 env[jmpenvp].base_stack = sp - stack;
297 env[jmpenvp].base_estack = esp - estack;
298
299 for (;;) {
300 push(Lread(0));
301 if (valuec > 1 && null(values[1])) {
302 break;
303 }
304 (void)Leval(1);
305 }
306 retval = 1;
307 }
308
309 if (ckverbose >= CANNA_HALF_VERBOSE) {
310 outstream = saved_outstream;
311 }
312
313 jmpenvp++;
314 quit_parse_rcfile:
315 return retval;
316 }
317
318 #define WITH_MAIN
319 #ifdef WITH_MAIN
320
321 static void
intr(sig)322 intr(sig)
323 int sig;
324 /* ARGSUSED */
325 {
326 error("Interrupt:",NON);
327 /* NOTREACHED */
328 }
329
330 /* cfuncdef
331
332 parse_string -- ʸ�����ѡ������롣
333
334 */
335
parse_string(str)336 parse_string(str)
337 char *str;
338 {
339 char *readbufbk;
340
341 if (clisp_init() == 0) {
342 return -1;
343 }
344
345 /* read buffer �Ȥ���Ϳ����줿ʸ����Ȥ� */
346 readbufbk = readbuf;
347 readptr = readbuf = str;
348
349 if (setjmp(fatal_env)) {
350 goto quit_parse_string;
351 }
352
353 if (jmpenvp <= 0) { /* �Ƶ������������� */
354 return -1;
355 }
356
357 jmpenvp--;
358 files[++filep].f = (FILE *)0;
359 files[filep].name = (char *)0;
360 files[filep].line = 0;
361
362 setjmp(env[jmpenvp].jmp_env);
363 env[jmpenvp].base_stack = sp - stack;
364 env[jmpenvp].base_estack = esp - estack;
365
366 for (;;) {
367 list t;
368
369 t = Lread(0);
370 if (valuec > 1 && null(values[1])) {
371 break;
372 }
373 else {
374 push(t);
375 Leval(1);
376 }
377 }
378 jmpenvp++;
379 quit_parse_string:
380 readbuf = readbufbk;
381 clisp_fin();
382 return 0;
383 }
384
385 static void intr();
386
387 void
clisp_main()388 clisp_main()
389 {
390 if (clisp_init() == 0) { /* initialize data area & etc.. */
391 fprintf(stderr, "CannaLisp: initialization failed.\n");
392 exit(1);
393 }
394
395 if (setjmp(fatal_env)) {
396 goto quit_clisp_main;
397 }
398
399 if (jmpenvp <= 0) { /* �Ƶ������������� */
400 return;
401 }
402 jmpenvp--;
403
404 fprintf(stderr,"CannaLisp listener %d.%d%s\n",
405 CANNA_MAJOR_MINOR / 1000, CANNA_MAJOR_MINOR % 1000,
406 CANNA_PATCH_LEVEL);
407
408 outstream = stdout;
409
410 setjmp(env[jmpenvp].jmp_env);
411 env[jmpenvp].base_stack = sp - stack;
412 env[jmpenvp].base_estack = esp - estack;
413
414 signal(SIGINT, intr);
415 for (;;) {
416 prins("-> "); /* prompt */
417 push(Lread(0));
418 if (valuec > 1 && null(values[1])) {
419 break;
420 }
421 push(Leval(1));
422 if (sp[0] == LISPERROR) {
423 (void)pop1();
424 }
425 else {
426 (void)Lprint(1);
427 prins("\n");
428 }
429 }
430 jmpenvp++;
431 quit_clisp_main:
432 prins("\nGoodbye.\n");
433 clisp_fin();
434 }
435
436 #endif /* WITH_MAIN */
437
438 static int longestkeywordlen;
439
440 typedef struct {
441 char *seq;
442 int id;
443 } SeqToID;
444
445 static SeqToID keywordtable[] = {
446 {"Space" ,' '},
447 {"Escape" ,'\033'},
448 {"Tab" ,'\t'},
449 {"Nfer" ,CANNA_KEY_Nfer},
450 {"Xfer" ,CANNA_KEY_Xfer},
451 {"Backspace" ,'\b'},
452 {"Delete" ,'\177'},
453 {"Insert" ,CANNA_KEY_Insert},
454 {"Rollup" ,CANNA_KEY_Rollup},
455 {"Rolldown" ,CANNA_KEY_Rolldown},
456 {"Up" ,CANNA_KEY_Up},
457 {"Left" ,CANNA_KEY_Left},
458 {"Right" ,CANNA_KEY_Right},
459 {"Down" ,CANNA_KEY_Down},
460 {"Home" ,CANNA_KEY_Home},
461 {"Clear" ,'\013'},
462 {"Help" ,CANNA_KEY_Help},
463 {"End" ,CANNA_KEY_End},
464 {"Enter" ,'\n'},
465 {"Return" ,'\r'},
466 /* "F1" is processed by program */
467 {"F2" ,CANNA_KEY_F2},
468 {"F3" ,CANNA_KEY_F3},
469 {"F4" ,CANNA_KEY_F4},
470 {"F5" ,CANNA_KEY_F5},
471 {"F6" ,CANNA_KEY_F6},
472 {"F7" ,CANNA_KEY_F7},
473 {"F8" ,CANNA_KEY_F8},
474 {"F9" ,CANNA_KEY_F9},
475 {"F10" ,CANNA_KEY_F10},
476 /* "Pf1" is processed by program */
477 {"Pf2" ,CANNA_KEY_PF2},
478 {"Pf3" ,CANNA_KEY_PF3},
479 {"Pf4" ,CANNA_KEY_PF4},
480 {"Pf5" ,CANNA_KEY_PF5},
481 {"Pf6" ,CANNA_KEY_PF6},
482 {"Pf7" ,CANNA_KEY_PF7},
483 {"Pf8" ,CANNA_KEY_PF8},
484 {"Pf9" ,CANNA_KEY_PF9},
485 {"Pf10" ,CANNA_KEY_PF10},
486 {"Hiragana" ,CANNA_KEY_HIRAGANA},
487 {"Katakana" ,CANNA_KEY_KATAKANA},
488 {"Hankakuzenkaku" ,CANNA_KEY_HANKAKUZENKAKU},
489 {"Eisu" ,CANNA_KEY_EISU},
490 {"S-Nfer" ,CANNA_KEY_Shift_Nfer},
491 {"S-Xfer" ,CANNA_KEY_Shift_Xfer},
492 {"S-Up" ,CANNA_KEY_Shift_Up},
493 {"S-Down" ,CANNA_KEY_Shift_Down},
494 {"S-Left" ,CANNA_KEY_Shift_Left},
495 {"S-Right" ,CANNA_KEY_Shift_Right},
496 {"C-Nfer" ,CANNA_KEY_Cntrl_Nfer},
497 {"C-Xfer" ,CANNA_KEY_Cntrl_Xfer},
498 {"C-Up" ,CANNA_KEY_Cntrl_Up},
499 {"C-Down" ,CANNA_KEY_Cntrl_Down},
500 {"C-Left" ,CANNA_KEY_Cntrl_Left},
501 {"C-Right" ,CANNA_KEY_Cntrl_Right},
502 {0 ,0},
503 };
504
505 #define charToNum(c) charToNumTbl[(c) - ' ']
506
507 static int *charToNumTbl;
508
509 typedef struct {
510 int id;
511 int *tbl;
512 } seqlines;
513
514 static seqlines *seqTbl; /* ������ɽ(�ºݤˤ�ɽ��ɽ) */
515 static int nseqtbl; /* ���֤ο������֤ο�����ɽ������ */
516 static int nseq;
517 static int seqline;
518
519 static
initIS()520 initIS()
521 {
522 SeqToID *p;
523 char *s;
524 int i;
525 seqlines seqTbls[1024];
526
527 seqTbl = (seqlines *)0;
528 seqline = 0;
529 nseqtbl = 0;
530 nseq = 0;
531 longestkeywordlen = 0;
532 for (i = 0 ; i < 1024 ; i++) {
533 seqTbls[i].tbl = (int *)0;
534 seqTbls[i].id = 0;
535 }
536 charToNumTbl = (int *)calloc('~' - ' ' + 1, sizeof(int));
537 if ( !charToNumTbl ) {
538 return 0;
539 }
540
541 /* �ޤ���ʸ���Ȥ��Ƥ��뤫��Ĵ�٤롣
542 nseq �ϻȤ��Ƥ���ʸ������꣱�礭���ͤǤ��� */
543 for (p = keywordtable ; p->id ; p++) {
544 int len = 0;
545 for (s = p->seq ; *s ; s++) {
546 if ( !charToNumTbl[*s - ' '] ) {
547 charToNumTbl[*s - ' '] = nseq; /* ��ʸ���˥��ꥢ���ֹ���� */
548 nseq++;
549 }
550 len ++;
551 }
552 if (len > longestkeywordlen) {
553 longestkeywordlen = len;
554 }
555 }
556 /* ʸ����ʬ�Υơ��֥� */
557 seqTbls[nseqtbl].tbl = (int *)calloc(nseq, sizeof(int));
558 if ( !seqTbls[nseqtbl].tbl ) {
559 goto initISerr;
560 }
561 nseqtbl++;
562 for (p = keywordtable ; p->id ; p++) {
563 int line, nextline;
564
565 line = 0;
566 for (s = p->seq ; *s ; s++) {
567 if (seqTbls[line].tbl == 0) { /* �ơ��֥뤬�ʤ� */
568 seqTbls[line].tbl = (int *)calloc(nseq, sizeof(int));
569 if ( !seqTbls[line].tbl ) {
570 goto initISerr;
571 }
572 }
573 nextline = seqTbls[line].tbl[charToNum(*s)];
574 /* ���ʤߤˡ�charToNum(*s) �����Фˣ��ˤʤ�ʤ� */
575 if ( nextline ) {
576 line = nextline;
577 }
578 else { /* �ǽ�˥����������� */
579 line = seqTbls[line].tbl[charToNum(*s)] = nseqtbl++;
580 }
581 }
582 seqTbls[line].id = p->id;
583 }
584 seqTbl = (seqlines *)calloc(nseqtbl, sizeof(seqlines));
585 if ( !seqTbl ) {
586 goto initISerr;
587 }
588 for (i = 0 ; i < nseqtbl ; i++) {
589 seqTbl[i].id = seqTbls[i].id;
590 seqTbl[i].tbl = seqTbls[i].tbl;
591 }
592 return 1;
593
594 initISerr:
595 free(charToNumTbl);
596 charToNumTbl = (int *)0;
597 if (seqTbl) {
598 free(seqTbl);
599 seqTbl = (seqlines *)0;
600 }
601 for (i = 0 ; i < nseqtbl ; i++) {
602 if (seqTbls[i].tbl) {
603 free(seqTbls[i].tbl);
604 seqTbls[i].tbl = (int *)0;
605 }
606 }
607 return 0;
608 }
609
610 static void
finIS()611 finIS() /* identifySequence ���Ѥ���������������� */
612 {
613 int i;
614
615 if (seqTbl) {
616 for (i = 0 ; i < nseqtbl ; i++) {
617 if (seqTbl[i].tbl) free(seqTbl[i].tbl);
618 seqTbl[i].tbl = (int *)0;
619 }
620 free(seqTbl);
621 seqTbl = (seqlines *)0;
622 }
623 if (charToNumTbl) {
624 free(charToNumTbl);
625 charToNumTbl = (int *)0;
626 }
627 }
628
629 /* cvariable
630
631 seqline: identifySequence �Ǥξ��֤��ݻ������ѿ�
632
633 */
634
635 #define CONTINUE 1
636 #define END 0
637
638 static
identifySequence(c,val)639 identifySequence(c, val)
640 unsigned c;
641 int *val;
642 {
643 int nextline;
644
645 if (' ' <= c && c <= '~' && charToNum(c) &&
646 (nextline = seqTbl[seqline].tbl[charToNum(c)]) ) {
647 seqline = nextline;
648 *val = seqTbl[seqline].id;
649 if (*val) {
650 seqline = 0;
651 return END;
652 }
653 else {
654 return CONTINUE; /* continue */
655 }
656 }
657 else {
658 *val = -1;
659 seqline = 0;
660 return END;
661 }
662 }
663
664
665 static int
alloccell()666 alloccell()
667 {
668 int cellsize, odd;
669 char *p;
670
671 cellsize = ncells * sizeof(list);
672 p = malloc(cellsize);
673 if (p == (char *)0) {
674 return 0;
675 }
676 memtop = p;
677 odd = (int)((pointerint)memtop % sizeof(list));
678 freecell = celltop = memtop + (odd ? (sizeof(list)) - odd : 0);
679 cellbtm = memtop + cellsize - odd;
680 return 1;
681 }
682
683 /* ���ޤ��Ԥ��ʤ��ä��飰���֤� */
684
685 static
allocarea()686 allocarea()
687 {
688 /* �ޤ��ϥ����ΰ� */
689 if (alloccell()) {
690 /* �����å��ΰ� */
691 stack = (list *)calloc(STKSIZE, sizeof(list));
692 if (stack) {
693 estack = (list *)calloc(STKSIZE, sizeof(list));
694 if (estack) {
695 /* oblist */
696 oblist = (list *)calloc(BUFSIZE, sizeof(list));
697 if (oblist) {
698 /* I/O */
699 filep = 0;
700 files = (lispfile *)calloc(MAX_DEPTH, sizeof(lispfile));
701 if (files) {
702 readbuf = malloc(BUFSIZE);
703 if (readbuf) {
704 /* jump env */
705 jmpenvp = MAX_DEPTH;
706 env = (struct lispcenv *)
707 calloc(MAX_DEPTH, sizeof(struct lispcenv));
708 if (env) {
709 /* multiple values returning buffer */
710 valuec = 1;
711 values = (list *)calloc(MAXVALUES, sizeof(list));
712 if (values) {
713 return 1;
714 }
715 free(env);
716 }
717 free(readbuf);
718 }
719 free(files);
720 }
721 free(oblist);
722 }
723 free(estack);
724 }
725 free(stack);
726 }
727 free(memtop);
728 }
729 return 0;
730 }
731
732 static void
freearea()733 freearea()
734 {
735 free((char *)memtop);
736 free((char *)stack);
737 free((char *)estack);
738 free((char *)oblist);
739 free((char *)files);
740 free((char *)env);
741 free((char *)readbuf);
742 if (values) {
743 free(values);
744 values = 0;
745 }
746 }
747
748 static list
getatmz(name)749 getatmz(name)
750 char *name;
751 {
752 int key;
753 char *p;
754
755 for (p = name, key = 0 ; *p ; p++)
756 key += *p;
757 return getatm(name,key);
758 }
759
760 /* mkatm -
761 making symbol function */
762
763 static list
mkatm(name)764 mkatm(name)
765 char *name;
766 {
767 list temp;
768 struct atomcell *newatom;
769
770 temp = newsymbol(name);
771 newatom = symbolpointer(temp);
772 newatom->value = (*name == ':') ? (list)temp : (list)UNBOUND;
773 newatom->plist = NIL; /* set null plist */
774 newatom->ftype = UNDEF; /* set undef func-type */
775 newatom->func = (list (*)())0; /* Don't kill this line */
776 newatom->valfunc = (list (*)())0; /* Don't kill this line */
777 newatom->hlink = NIL; /* no hash linking */
778 newatom->mid = -1;
779 newatom->fid = -1;
780
781 return temp;
782 }
783
784 /* getatm -- get atom from the oblist if possible */
785
786 static list
getatm(name,key)787 getatm(name,key)
788 char *name;
789 int key;
790 {
791 list p;
792 struct atomcell *atomp;
793
794 key &= 0x00ff;
795 for (p = oblist[key] ; p ;) {
796 atomp = symbolpointer(p);
797 if (!strcmp(atomp->pname, name)) {
798 return p;
799 }
800 p = atomp->hlink;
801 }
802 p = mkatm(name);
803 atomp = symbolpointer(p);
804 atomp->hlink = oblist[key];
805 oblist[key] = p;
806 return p;
807 }
808
809 #define MESSAGE_MAX 256
810
811 static void
error(msg,v)812 error(msg,v)
813 char *msg;
814 list v;
815 /* ARGSUSED */
816 {
817 char buf[MESSAGE_MAX];
818
819 prins(msg);
820 if (v != (list)NON)
821 print(v);
822 if (files[filep].f == stdin) {
823 prins("\n");
824 }
825 else {
826 if (files[filep].name) {
827 sprintf(buf, " (%s near line %d)\n",
828 files[filep].name, files[filep].line);
829 }
830 else {
831 sprintf(buf, " (near line %d)\n", files[filep].line);
832 }
833 prins(buf);
834 }
835 sp = &stack[env[jmpenvp].base_stack];
836 esp = &estack[env[jmpenvp].base_estack];
837 /* epush(NIL); */
838 longjmp(env[jmpenvp].jmp_env,YES);
839 }
840
841 static void
fatal(msg,v)842 fatal(msg,v)
843 char *msg;
844 list v;
845 /* ARGSUSED */
846 {
847 char buf[MESSAGE_MAX];
848
849 prins(msg);
850 if (v != (list)NON)
851 print(v);
852 if (files[filep].f == stdin) {
853 prins("\n");
854 }
855 else {
856 if (files[filep].name) {
857 sprintf(buf, " (%s near line %d)\n",
858 files[filep].name, files[filep].line);
859 }
860 else {
861 sprintf(buf, " (near line %d)\n", files[filep].line);
862 }
863 prins(buf);
864 }
865 longjmp(fatal_env, 1);
866 }
867
868 static void
argnerr(msg)869 argnerr(msg)
870 char *msg;
871 {
872 prins("incorrect number of args to ");
873 error(msg, NON);
874 /* NOTREACHED */
875 }
876
877 static void
numerr(fn,arg)878 numerr(fn,arg)
879 char *fn;
880 list arg;
881 {
882 prins("Non-number ");
883 if (fn) {
884 prins("to ");
885 prins(fn);
886 }
887 error(": ",arg);
888 /* NOTREACHED */
889 }
890
891 static void
lisp_strerr(fn,arg)892 lisp_strerr(fn,arg)
893 char *fn;
894 list arg;
895 {
896 prins("Non-string ");
897 if (fn) {
898 prins("to ");
899 prins(fn);
900 }
901 error(": ",arg);
902 /* NOTREACHED */
903 }
904
905 static list
Lread(n)906 Lread(n)
907 int n;
908 {
909 list t;
910
911 argnchk("read",0);
912 valuec = 1;
913 if ((t = read1()) == (list)LISPERROR) {
914 readptr = readbuf;
915 *readptr = '\0';
916 if (files[filep].f != stdin) {
917 if (files[filep].f)
918 fclose(files[filep].f);
919 if (files[filep].name) {
920 free(files[filep].name);
921 }
922 filep--;
923 }
924 values[0] = NIL;
925 values[1] = NIL;
926 valuec = 2;
927 return(NIL);
928 }
929 else {
930 values[0] = t;
931 values[1] = T;
932 valuec = 2;
933 return(t);
934 }
935 /* NOTREACHED */
936 }
937
938 static void untyi pro((int));
939 static list rcharacter pro((void));
940
941 static list
read1()942 read1()
943 {
944 int c;
945 list p, *pp;
946 list t;
947 char *eofmsg = "EOF hit in reading a list : ";
948
949 lab:
950 if ( !skipspaces() ) {
951 return((list)LISPERROR);
952 }
953 switch (c = tyi()) {
954 case '(':
955 push(NIL);
956 p = Lncons(1); /* get a new cell */
957 car(p) = p;
958 push(p);
959 pp = sp;
960
961 for (;;) {
962 lab2:
963 if ( !skipspaces() ) {
964 error(eofmsg,cdr(*pp));
965 /* NOTREACHED */
966 }
967 switch (c = tyi()) {
968 case ';':
969 zaplin();
970 goto lab2;
971 case ')':
972 return(cdr(pop1()));
973 case '.':
974 if ( !(c = tyipeek()) ) {
975 error(eofmsg,cdr(*pp));
976 /* NOTREACHED */
977 }
978 else if ( !isterm(c) ) {
979 push(ratom2('.'));
980 push(NIL);
981 car(*pp) = cdar(*pp) = Lcons(2);
982 break;
983 }
984 else {
985 cdar(*pp) = read1();
986 if (cdar(*pp) == (list)LISPERROR) {
987 error(eofmsg,cdr(*pp));
988 /* NOTREACHED */
989 }
990 while (')' != (c = tyi()))
991 if ( !c ) {
992 error(eofmsg,cdr(*pp));
993 /* NOTREACHED */
994 }
995 return(cdr(pop1()));
996 }
997 default:
998 untyi(c);
999 if ((t = read1()) == (list)LISPERROR) {
1000 error(eofmsg,cdr(*pp));
1001 /* NOTREACHED */
1002 }
1003 push(t);
1004 push(NIL);
1005 car(*pp) = cdar(*pp) = Lcons(2);
1006 }
1007 }
1008 case '\'':
1009 push(QUOTE);
1010 if ((t = read1()) == (list)LISPERROR) {
1011 error(eofmsg,NIL);
1012 /* NOTREACHED */
1013 }
1014 push(t);
1015 push(NIL);
1016 push(Lcons(2));
1017 return Lcons(2);
1018 case '"':
1019 return rstring();
1020 case '?':
1021 return rcharacter();
1022 case ';':
1023 zaplin();
1024 goto lab;
1025 default:
1026 untyi(c);
1027 return ratom();
1028 }
1029 }
1030
1031 /* skipping spaces function -
1032 if eof read then return NO */
1033
1034 static
skipspaces()1035 skipspaces()
1036 {
1037 int c;
1038
1039 while ((c = tyi()) <= ' ') {
1040 if ( !c ) {
1041 return(NO);
1042 }
1043 #ifdef QUIT_IF_BINARY_CANNARC
1044 /* �¤� fatal() �ˤ��Ƥ��ޤ��� read �Ǥ��ʤ��ä��Ȼפ������Υե������
1045 õ���˹Ԥ��ΤǤ��ޤ��ɤ��ʤ���return ��������Ȥ�����Ѥ��ʤ���Ф�
1046 ��ʤ������ݤʤΤǡ��Ȥꤢ�������� */
1047 if (c != '\033' && c != '\n' && c != '\r' && c!= '\t' && c < ' ') {
1048 fatal("read: Binary data read.", NON);
1049 }
1050 #endif
1051 }
1052 untyi(c);
1053 return(YES);
1054 }
1055
1056 /* skip reading until '\n' -
1057 if eof read then return NO */
1058
1059 static
zaplin()1060 zaplin()
1061 {
1062 int c;
1063
1064 while ((c = tyi()) != '\n')
1065 if ( !c )
1066 return(NO);
1067 return(YES);
1068 }
1069
1070 static void gc();
1071
1072 static list
newcons()1073 newcons()
1074 {
1075 list retval;
1076
1077 if (freecell + sizeof(struct cell) >= cellbtm) {
1078 gc();
1079 }
1080 retval = CONS_TAG | (freecell - celltop);
1081 freecell += sizeof(struct cell);
1082 return retval;
1083 }
1084
1085 static list
newsymbol(name)1086 newsymbol(name)
1087 char *name;
1088 {
1089 list retval;
1090 struct atomcell *temp;
1091 int namesize;
1092
1093 namesize = strlen(name);
1094 namesize = ((namesize / sizeof(list)) + 1) * sizeof(list); /* +1��'\0'��ʬ */
1095 if (freecell + (sizeof(struct atomcell)) + namesize >= cellbtm) {
1096 gc();
1097 }
1098 temp = (struct atomcell *)freecell;
1099 retval = SYMBOL_TAG | (freecell - celltop);
1100 freecell += sizeof(struct atomcell);
1101 (void)strcpy(freecell, name);
1102 temp->pname = freecell;
1103 freecell += namesize;
1104
1105 return retval;
1106 }
1107
1108 static void patom();
1109
1110 static void
print(l)1111 print(l)
1112 list l;
1113 {
1114 if ( !l ) /* case NIL */
1115 prins("nil");
1116 else if (atom(l))
1117 patom(l);
1118 else {
1119 tyo('(');
1120 print(car(l));
1121 for (l = cdr(l) ; l ; l = cdr(l)) {
1122 tyo(' ');
1123 if (atom(l)) {
1124 tyo('.');
1125 tyo(' ');
1126 patom(l);
1127 break;
1128 }
1129 else
1130 print(car(l));
1131 }
1132 tyo(')');
1133 }
1134 }
1135
1136
1137
1138 /*
1139 ** read atom
1140 */
1141
1142
1143 static list
ratom()1144 ratom()
1145 {
1146 return(ratom2(tyi()));
1147 }
1148
1149 /* read atom with the first one character -
1150 check if the token is numeric or pure symbol & return proper value */
1151
1152 static isnum();
1153
1154 static list
ratom2(a)1155 ratom2(a)
1156 int a;
1157 {
1158 int i, c, flag;
1159 char atmbuf[BUFSIZE];
1160
1161 flag = NO;
1162 if (a == '\\') {
1163 flag = YES;
1164 a = tyi();
1165 }
1166 atmbuf[0] = a;
1167 for (i = 1, c = tyi(); !isterm(c) ; i++, c = tyi()) {
1168 if ( !c ) {
1169 error("Eof hit in reading symbol.", NON);
1170 /* NOTREACHED */
1171 }
1172 if (c == '\\') {
1173 flag = YES;
1174 }
1175 if (i < BUFSIZE) {
1176 atmbuf[i] = c;
1177 }
1178 else {
1179 error("Too long symbol name read", NON);
1180 /* NOTREACHED */
1181 }
1182 }
1183 untyi(c);
1184 if (i < BUFSIZE) {
1185 atmbuf[i] = '\0';
1186 }
1187 else {
1188 error("Too long symbol name read", NON);
1189 /* NOTREACHED */
1190 }
1191 if ( !flag && isnum(atmbuf)) {
1192 return(mknum(atoi(atmbuf)));
1193 }
1194 else if ( !flag && !strcmp("nil",atmbuf) ) {
1195 return(NIL);
1196 }
1197 else {
1198 return (getatmz(atmbuf));
1199 }
1200 }
1201
1202 static list
rstring()1203 rstring()
1204 {
1205 char strb[BUFSIZE];
1206 int c;
1207 int strp = 0;
1208
1209 while ((c = tyi()) != '"') {
1210 if ( !c ) {
1211 error("Eof hit in reading a string.", NON);
1212 /* NOTREACHED */
1213 }
1214 if (strp < BUFSIZE) {
1215 if (c == '\\') {
1216 untyi(c);
1217 c = (char)(((canna_uintptr_t)rcharacter()) & 0xff);
1218 }
1219 strb[strp++] = (char)c;
1220 }
1221 else {
1222 error("Too long string read.", NON);
1223 /* NOTREACHED */
1224 }
1225 }
1226 if (strp < BUFSIZE) {
1227 strb[strp] = '\0';
1228 }
1229 else {
1230 error("Too long string read.", NON);
1231 /* NOTREACHED */
1232 }
1233
1234 return copystring(strb, strp);
1235 }
1236
1237 /* rcharacter -- ��ʸ���ɤ����롣 */
1238
1239 static list
rcharacter()1240 rcharacter()
1241 {
1242 char *tempbuf;
1243 unsigned ch;
1244 list retval;
1245 int bufp;
1246
1247 tempbuf = malloc(longestkeywordlen + 1);
1248 if ( !tempbuf ) {
1249 fatal("read: malloc failed in reading character.", NON);
1250 /* NOTREACHED */
1251 }
1252 bufp = 0;
1253
1254 ch = tyi();
1255 if (ch == '\\') {
1256 int code, res;
1257
1258 do { /* ������ɤȾȹ礹�� */
1259 tempbuf[bufp++] = ch = tyi();
1260 res = identifySequence(ch, &code);
1261 } while (res == CONTINUE);
1262 if (code != -1) { /* ������ɤȰ��פ����� */
1263 retval = mknum(code);
1264 }
1265 else if (bufp > 2 && tempbuf[0] == 'C' && tempbuf[1] == '-') {
1266 while (bufp > 3) {
1267 untyi(tempbuf[--bufp]);
1268 }
1269 retval = mknum(tempbuf[2] & (' ' - 1));
1270 }
1271 else if (bufp == 3 && tempbuf[0] == 'F' && tempbuf[1] == '1') {
1272 untyi(tempbuf[2]);
1273 retval = mknum(CANNA_KEY_F1);
1274 }
1275 else if (bufp == 4 && tempbuf[0] == 'P' && tempbuf[1] == 'f' &&
1276 tempbuf[2] == '1') {
1277 untyi(tempbuf[3]);
1278 retval = mknum(CANNA_KEY_PF1);
1279 }
1280 else { /* �������� */
1281 while (bufp > 1) {
1282 untyi(tempbuf[--bufp]);
1283 }
1284 ch = (unsigned)(unsigned char)tempbuf[0];
1285 goto return_char;
1286 }
1287 }
1288 else {
1289 return_char:
1290 if (ch == 0x8f) { /* SS3 */
1291 ch <<= 8;
1292 ch += tyi();
1293 goto shift_more;
1294 }
1295 else if (ch & 0x80) { /* ���������ܸ�˰�¸���Ƥ��� */
1296 shift_more:
1297 ch <<= 8;
1298 ch += tyi();
1299 }
1300 retval = mknum(ch);
1301 }
1302
1303 free(tempbuf);
1304 return retval;
1305 }
1306
isnum(name)1307 static isnum(name)
1308 char *name;
1309 {
1310 if (*name == '-') {
1311 name++;
1312 if ( !*name )
1313 return(NO);
1314 }
1315 for(; *name ; name++) {
1316 if (*name < '0' || '9' < *name) {
1317 if (*name != '.' || *(name + 1)) {
1318 return(NO);
1319 }
1320 }
1321 }
1322 return(YES);
1323 }
1324
1325 /* tyi -- input one character from buffered stream */
1326
1327 static void
untyi(c)1328 untyi(c)
1329 int c;
1330 {
1331 if (readbuf < readptr) {
1332 *--readptr = c;
1333 }
1334 else {
1335 if (untyip >= untyisize) {
1336 if (untyisize == 0) {
1337 untyibuf = malloc(UNTYIUNIT);
1338 if (untyibuf) {
1339 untyisize = UNTYIUNIT;
1340 }
1341 }
1342 else {
1343 untyibuf = realloc(untyibuf, UNTYIUNIT + untyisize);
1344 if (untyibuf) {
1345 untyisize += UNTYIUNIT;
1346 }
1347 }
1348 }
1349 if (untyip < untyisize) { /* ����Ǥ�����å����� */
1350 untyibuf[untyip++] = c;
1351 }
1352 }
1353 }
1354
1355 static int
tyi()1356 tyi()
1357 {
1358 char *gets(), *fgets();
1359
1360 if (untyibuf) {
1361 int ret = untyibuf[--untyip];
1362 if (untyip == 0) {
1363 free(untyibuf);
1364 untyibuf = (char *)0;
1365 untyisize = 0;
1366 }
1367 return ret;
1368 }
1369
1370 if (readptr && *readptr) {
1371 return ((int)(unsigned char)*readptr++);
1372 }
1373 else if (!files[filep].f) {
1374 return NO;
1375 }
1376 else if (files[filep].f == stdin) {
1377 readptr = fgets(readbuf, BUFSIZE, stdin);
1378 files[filep].line++;
1379 if ( !readptr ) {
1380 return NO;
1381 }
1382 else {
1383 return tyi();
1384 }
1385 }
1386 else {
1387 readptr = fgets(readbuf,BUFSIZE,files[filep].f);
1388 files[filep].line++;
1389 if (readptr) {
1390 return(tyi());
1391 }
1392 else {
1393 return(NO);
1394 }
1395 }
1396 /* NOTREACHED */
1397 }
1398
1399 /* tyipeek -- input one character without advance the read pointer */
1400
1401 static int
tyipeek()1402 tyipeek()
1403 {
1404 int c = tyi();
1405 untyi(c);
1406 return c;
1407 }
1408
1409 /* tyo -- output one character */
1410
tyo(c)1411 static void tyo(c)
1412 int c;
1413 {
1414 if (outstream) {
1415 (void)putc(c, outstream);
1416 }
1417 }
1418
1419
1420 /* prins -
1421 print string */
1422
prins(s)1423 static void prins(s)
1424 char *s;
1425 {
1426 while (*s) {
1427 tyo(*s++);
1428 }
1429 }
1430
1431
1432 /* isterm -
1433 check if the character is terminating the lisp expression */
1434
isterm(c)1435 static isterm(c)
1436 int c;
1437 {
1438 if (c <= ' ')
1439 return(YES);
1440 else {
1441 switch (c)
1442 {
1443 case '(':
1444 case ')':
1445 case ';':
1446 return(YES);
1447 default:
1448 return(NO);
1449 }
1450 }
1451 }
1452
1453 /* push down an S-expression to parameter stack */
1454
1455 static void
push(value)1456 push(value)
1457 list value;
1458 {
1459 if (sp <= stack) {
1460 error("Stack over flow",NON);
1461 /* NOTREACHED */
1462 }
1463 else
1464 *--sp = value;
1465 }
1466
1467 /* pop up n S-expressions from parameter stack */
1468
1469 static void
pop(x)1470 pop(x)
1471 int x;
1472 {
1473 if (0 < x && sp >= &stack[STKSIZE]) {
1474 error("Stack under flow",NON);
1475 /* NOTREACHED */
1476 }
1477 sp += x;
1478 }
1479
1480 /* pop up an S-expression from parameter stack */
1481
1482 static list
pop1()1483 pop1()
1484 {
1485 if (sp >= &stack[STKSIZE]) {
1486 error("Stack under flow",NON);
1487 /* NOTREACHED */
1488 }
1489 return(*sp++);
1490 }
1491
1492 static void
epush(value)1493 epush(value)
1494 list value;
1495 {
1496 if (esp <= estack) {
1497 error("Estack over flow",NON);
1498 /* NOTREACHED */
1499 }
1500 else
1501 *--esp = value;
1502 }
1503
1504 static list
epop()1505 epop()
1506 {
1507 if (esp >= &estack[STKSIZE]) {
1508 error("Lstack under flow",NON);
1509 /* NOTREACHED */
1510 }
1511 return(*esp++);
1512 }
1513
1514
1515 /*
1516 ** output function for lisp S-Expression
1517 */
1518
1519
1520 /*
1521 ** print atom function
1522 ** please make sure it is an atom (not list)
1523 ** no check is done here.
1524 */
1525
1526 static void
patom(atm)1527 patom(atm)
1528 list atm;
1529 {
1530 char namebuf[BUFSIZE];
1531
1532 if (constp(atm)) {
1533 if (numberp(atm)) {
1534 (void)sprintf(namebuf,"%d",(int)xnum(atm));
1535 prins(namebuf);
1536 }
1537 else { /* this is a string */
1538 int i, len = xstrlen(atm);
1539 char *s = xstring(atm);
1540
1541 tyo('"');
1542 for (i = 0 ; i < len ; i++) {
1543 tyo(s[i]);
1544 }
1545 tyo('"');
1546 }
1547 }
1548 else {
1549 prins(symbolpointer(atm)->pname);
1550 }
1551 }
1552
1553 static void markcopycell();
1554
1555 static char *oldcelltop;
1556 static char *oldcellp;
1557
1558 #define oldpointer(x) (oldcelltop + celloffset(x))
1559
1560 static void
gc()1561 gc() /* ���ԡ������Υ����٥����쥯�����Ǥ��� */
1562 {
1563 int i;
1564 list *p;
1565 static int under_gc = 0;
1566
1567 if (under_gc) {
1568 fatal("GC: memory exhausted.", NON);
1569 }
1570 else {
1571 under_gc = 1;
1572 }
1573
1574 oldcellp = memtop; oldcelltop = celltop;
1575
1576 if ( !alloccell() ) {
1577 fatal("GC: failed in allocating new cell area.", NON);
1578 /* NOTREACHED */
1579 }
1580
1581 for (i = 0 ; i < BUFSIZE ; i++) {
1582 markcopycell(oblist + i);
1583 }
1584 for (p = sp ; p < &stack[STKSIZE] ; p++) {
1585 markcopycell(p);
1586 }
1587 for (p = esp ; p < &estack[STKSIZE] ; p++) {
1588 markcopycell(p);
1589 }
1590 for (i = 0 ; i < valuec ; i++) {
1591 markcopycell(values + i);
1592 }
1593 markcopycell(&T);
1594 markcopycell("E);
1595 markcopycell(&_LAMBDA);
1596 markcopycell(&_MACRO);
1597 markcopycell(&COND);
1598 markcopycell(&USER);
1599 markcopycell(&BUSHU);
1600 markcopycell(&GRAMMAR);
1601 markcopycell(&RENGO);
1602 markcopycell(&KATAKANA);
1603 markcopycell(&HIRAGANA);
1604 markcopycell(&HYPHEN);
1605 free(oldcellp);
1606 if ((freecell - celltop) * 2 > cellbtm -celltop) {
1607 ncells = (freecell - celltop) * 2 / sizeof(list);
1608 }
1609 under_gc = 0;
1610 }
1611
1612 static char *Strncpy();
1613
1614 static list
allocstring(n)1615 allocstring(n)
1616 int n;
1617 {
1618 int namesize;
1619 list retval;
1620
1621 namesize = ((n + (sizeof(pointerint)) + 1 + 3)/ sizeof(list)) * sizeof(list);
1622 if (freecell + namesize >= cellbtm) { /* gc ��ϵ��������ʤ��Ϥ� */
1623 gc();
1624 }
1625 ((struct stringcell *)freecell)->length = n;
1626 retval = STRING_TAG | (freecell - celltop);
1627 freecell += namesize;
1628 return retval;
1629 }
1630
1631 static list
copystring(s,n)1632 copystring(s, n)
1633 char *s;
1634 int n;
1635 {
1636 list retval;
1637
1638 retval = allocstring(n);
1639 (void)Strncpy(xstring(retval), s, n);
1640 xstring(retval)[n] = '\0';
1641 return retval;
1642 }
1643
1644 static list
copycons(l)1645 copycons(l)
1646 struct cell *l;
1647 {
1648 list newcell;
1649
1650 newcell = newcons();
1651 car(newcell) = l->head;
1652 cdr(newcell) = l->tail;
1653 return newcell;
1654 }
1655
1656 static void
markcopycell(addr)1657 markcopycell(addr)
1658 list *addr;
1659 {
1660 list temp;
1661 redo:
1662 if (null(*addr) || numberp(*addr)) {
1663 return;
1664 }
1665 else if (alreadycopied(oldpointer(*addr))) {
1666 *addr = newaddr(gcfield(oldpointer(*addr)));
1667 return;
1668 }
1669 else if (stringp(*addr)) {
1670 temp = copystring(((struct stringcell *)oldpointer(*addr))->str,
1671 ((struct stringcell *)oldpointer(*addr))->length);
1672 gcfield(oldpointer(*addr)) = mkcopied(temp);
1673 *addr = temp;
1674 return;
1675 }
1676 else if (consp(*addr)) {
1677 temp = copycons((struct cell *)(oldpointer(*addr)));
1678 gcfield(oldpointer(*addr)) = mkcopied(temp);
1679 *addr = temp;
1680 markcopycell(&car(temp));
1681 addr = &cdr(temp);
1682 goto redo;
1683 }
1684 else { /* symbol */
1685 struct atomcell *newatom, *oldatom;
1686
1687 oldatom = (struct atomcell *)(oldpointer(*addr));
1688 temp = newsymbol(oldatom->pname);
1689 newatom = symbolpointer(temp);
1690 newatom->value = oldatom->value;
1691 newatom->plist = oldatom->plist;
1692 newatom->ftype = oldatom->ftype;
1693 newatom->func = oldatom->func;
1694 newatom->fid = oldatom->fid;
1695 newatom->mid = oldatom->mid;
1696 newatom->valfunc = oldatom->valfunc;
1697 newatom->hlink = oldatom->hlink;
1698
1699 gcfield(oldpointer(*addr)) = mkcopied(temp);
1700 *addr = temp;
1701
1702 if (newatom->value != (list)UNBOUND) {
1703 markcopycell(&newatom->value);
1704 }
1705 markcopycell(&newatom->plist);
1706 if (newatom->ftype == EXPR || newatom->ftype == MACRO) {
1707 markcopycell((int *)&newatom->func);
1708 }
1709 addr = &newatom->hlink;
1710 goto redo;
1711 }
1712 }
1713
1714 static list
bindall(var,par,a,e)1715 bindall(var,par,a,e)
1716 list var, par, a, e;
1717 {
1718 list *pa, *pe, retval;
1719
1720 push(a); pa = sp;
1721 push(e); pe = sp;
1722 retry:
1723 if (constp(var)) {
1724 pop(2);
1725 return(*pa);
1726 }
1727 else if (atom(var)) {
1728 push(var);
1729 push(par);
1730 push(Lcons(2));
1731 push(*pa);
1732 retval = Lcons(2);
1733 pop(2);
1734 return retval;
1735 }
1736 else if (atom(par)) {
1737 error("Bad macro form ",e);
1738 /* NOTREACHED */
1739 }
1740 push(par);
1741 push(var);
1742 *pa = bindall(car(var),car(par),*pa,*pe);
1743 var = cdr(pop1());
1744 par = cdr(pop1());
1745 goto retry;
1746 /* NOTREACHED */
1747 }
1748
1749 static list
Lquote()1750 Lquote()
1751 {
1752 list p;
1753
1754 p = pop1();
1755 if (atom(p))
1756 return(NIL);
1757 else
1758 return(car(p));
1759 }
1760
1761 static list
Leval(n)1762 Leval(n)
1763 int n;
1764 {
1765 list e, t, s, tmp, aa, *pe, *pt, *ps, *paa;
1766 list fn, (*cfn)(), *pfn;
1767 int i, j;
1768 argnchk("eval",1);
1769 e = sp[0];
1770 pe = sp;
1771 if (atom(e)) {
1772 if (constp(e)) {
1773 pop1();
1774 return(e);
1775 }
1776 else {
1777 struct atomcell *sym;
1778
1779 t = assq(e, *esp);
1780 if (t) {
1781 (void)pop1();
1782 return(cdr(t));
1783 }
1784 else if ((sym = symbolpointer(e))->valfunc) {
1785 (void)pop1();
1786 return (sym->valfunc)(VALGET, 0);
1787 }
1788 else {
1789 if ((t = (sym->value)) != (list)UNBOUND) {
1790 pop1();
1791 return(t);
1792 }
1793 else {
1794 error("Unbound variable: ",*pe);
1795 /* NOTREACHED */
1796 }
1797 }
1798 }
1799 }
1800 else if (constp((fn = car(e)))) { /* not atom */
1801 error("eval: undefined function ", fn);
1802 /* NOTREACHED */
1803 }
1804 else if (atom(fn)) {
1805 switch (symbolpointer(fn)->ftype) {
1806 case UNDEF:
1807 error("eval: undefined function ", fn);
1808 /* NOTREACHED */
1809 break;
1810 case SUBR:
1811 cfn = symbolpointer(fn)->func;
1812 i = evpsh(cdr(e));
1813 epush(NIL);
1814 t = (*cfn)(i);
1815 epop();
1816 pop1();
1817 return (t);
1818 case SPECIAL:
1819 push(cdr(e));
1820 t = (*(symbolpointer(fn)->func))();
1821 pop1();
1822 return (t);
1823 case EXPR:
1824 fn = (list)(symbolpointer(fn)->func);
1825 aa = NIL; /* previous env won't be used */
1826 expr:
1827 if (atom(fn) || car(fn) != _LAMBDA || atom(cdr(fn))) {
1828 error("eval: bad lambda form ", fn);
1829 /* NOTREACHED */
1830 }
1831 /* Lambda binding begins here ... */
1832 s = cdr(e); /* actual parameter */
1833 t = cadr(fn); /* lambda list */
1834 push(s); ps = sp;
1835 push(t); pt = sp;
1836 push(fn); pfn = sp;
1837 push(aa); paa = sp;
1838 i = 0; /* count of variables */
1839 for (; consp(*ps) && consp(*pt) ; *ps = cdr(*ps), *pt = cdr(*pt)) {
1840 if (consp(car(*pt))) {
1841 tmp = cdar(*pt); /* push the cdr of element */
1842 if (!(atom(tmp) || null(cdr(tmp)))) {
1843 push(cdr(tmp));
1844 push(T);
1845 push(Lcons(2));
1846 i++;
1847 }
1848 push(caar(*pt));
1849 }
1850 else {
1851 push(car(*pt));
1852 }
1853 push(car(*ps));
1854 push(Leval(1));
1855 push(Lcons(2));
1856 i++;
1857 }
1858 for (; consp(*pt) ; *pt = cdr(*pt)) {
1859 if (atom(car(*pt))) {
1860 error("Too few actual parameters ",*pe);
1861 /* NOTREACHED */
1862 }
1863 else {
1864 tmp = cdar(*pt);
1865 if (!(atom(tmp) || null(cdr(tmp)))) {
1866 push(cdr(tmp));
1867 push(NIL);
1868 push(Lcons(2));
1869 i++;
1870 }
1871 push(caar(*pt));
1872 tmp = cdar(*pt); /* restore for GC */
1873 if (atom(tmp))
1874 push(NIL);
1875 else {
1876 push(car(tmp));
1877 push(Leval(1));
1878 }
1879 push(Lcons(2));
1880 i++;
1881 }
1882 }
1883 if (null(*pt) && consp(*ps)) {
1884 error("Too many actual arguments ",*pe);
1885 /* NOTREACHED */
1886 }
1887 else if (*pt) {
1888 push(*pt);
1889 for (j = 1 ; consp(*ps) ; j++) {
1890 push(car(*ps));
1891 push(Leval(1));
1892 *ps = cdr(*ps);
1893 }
1894 push(NIL);
1895 for (; j ; j--) {
1896 push(Lcons(2));
1897 }
1898 i++;
1899 }
1900 push(*paa);
1901 for (; i ; i--) {
1902 push(Lcons(2));
1903 }
1904 /* Lambda binding finished, and a new environment is established. */
1905 epush(pop1()); /* set the new environment */
1906 push(cddr(*pfn));
1907 t = Lprogn();
1908 epop();
1909 pop(5);
1910 return (t);
1911 case MACRO:
1912 fn = (list)(symbolpointer(fn)->func);
1913 if (atom(fn) || car(fn) != _MACRO || atom(cdr(fn))) {
1914 error("eval: bad macro form ",fn);
1915 /* NOTREACHED */
1916 }
1917 s = cdr(e); /* actual parameter */
1918 t = cadr(fn); /* lambda list */
1919 push(fn);
1920 epush(bindall(t,s,NIL,e));
1921 push(cddr(pop1()));
1922 t = Lprogn();
1923 epop();
1924 push(t);
1925 push(t);
1926 s = Leval(1);
1927 t = pop1();
1928 if (!atom(t)) {
1929 car(*pe) = car(t);
1930 cdr(*pe) = cdr(t);
1931 }
1932 pop1();
1933 return (s);
1934 case CMACRO:
1935 push(e);
1936 push(t = (*(symbolpointer(fn)->func))());
1937 push(t);
1938 s = Leval(1);
1939 t = pop1();
1940 if (!atom(t)) {
1941 car(e) = car(t);
1942 cdr(e) = cdr(t);
1943 }
1944 pop1();
1945 return (s);
1946 default:
1947 error("eval: unrecognized ftype used in ", fn);
1948 /* NOTREACHED */
1949 break;
1950 }
1951 /* NOTREACHED */
1952 }
1953 else { /* fn is list (lambda expression) */
1954 aa = *esp; /* previous environment is also used */
1955 goto expr;
1956 }
1957 /* maybe NOTREACHED */
1958 return NIL;
1959 }
1960
1961 static list
assq(e,a)1962 assq(e,a)
1963 list e, a;
1964 {
1965 list i;
1966
1967 for (i = a ; i ; i = cdr(i)) {
1968 if (consp(car(i)) && e == caar(i)) {
1969 return(car(i));
1970 }
1971 }
1972 return((list)NIL);
1973 }
1974
1975 /* eval each argument and push down each value to parameter stack */
1976
1977 static int
evpsh(args)1978 evpsh(args)
1979 list args;
1980 {
1981 int counter;
1982 list temp;
1983
1984 counter = 0;
1985 while (consp(args)) {
1986 push(args);
1987 push(car(args));
1988 temp = Leval(1);
1989 args = cdr(pop1());
1990 counter++;
1991 push(temp);
1992 }
1993 return (counter);
1994 }
1995
1996 /*
1997 static int
1998 psh(args)
1999 list args;
2000 {
2001 int counter;
2002
2003 counter = 0;
2004 while (consp(args)) {
2005 push(car(args));
2006 counter++;
2007 args = cdr(args);
2008 }
2009 return (counter);
2010 }
2011 */
2012
2013 static list
Lprogn()2014 Lprogn()
2015 {
2016 list val, *pf;
2017
2018 val = NIL;
2019 pf = sp;
2020 for (; consp(*pf) ; *pf = cdr(*pf)) {
2021 symbolpointer(T)->value = T;
2022 push(car(*pf));
2023 val = Leval(1);
2024 }
2025 pop1();
2026 return (val);
2027 }
2028
2029 static list
Lcons(n)2030 Lcons(n)
2031 int n;
2032 {
2033 list temp;
2034
2035 argnchk("cons",2);
2036 temp = newcons();
2037 cdr(temp) = pop1();
2038 car(temp) = pop1();
2039 return(temp);
2040 }
2041
2042 static list
Lncons(n)2043 Lncons(n)
2044 int n;
2045 {
2046 list temp;
2047
2048 argnchk("ncons",1);
2049 temp = newcons();
2050 car(temp) = pop1();
2051 cdr(temp) = NIL;
2052 return(temp);
2053 }
2054
2055 static list
Lxcons(n)2056 Lxcons(n)
2057 int n;
2058 {
2059 list temp;
2060
2061 argnchk("cons",2);
2062 temp = newcons();
2063 car(temp) = pop1();
2064 cdr(temp) = pop1();
2065 return(temp);
2066 }
2067
2068 static list
Lprint(n)2069 Lprint(n)
2070 int n;
2071 {
2072 print(sp[0]);
2073 pop(n);
2074 return (T);
2075 }
2076
2077 static list
Lset(n)2078 Lset(n)
2079 int n;
2080 {
2081 list val, t;
2082 list var;
2083 struct atomcell *sym;
2084
2085 argnchk("set",2);
2086 val = pop1();
2087 var = pop1();
2088 if (!symbolp(var)) {
2089 error("set/setq: bad variable type ",var);
2090 /* NOTREACHED */
2091 }
2092 sym = symbolpointer(var);
2093 t = assq(var,*esp);
2094 if (t) {
2095 return cdr(t) = val;
2096 }
2097 else if (sym->valfunc) {
2098 return (*(sym->valfunc))(VALSET, val);
2099 }
2100 else {
2101 return sym->value = val; /* global set */
2102 }
2103 }
2104
2105 static list
Lsetq()2106 Lsetq()
2107 {
2108 list a, *pp;
2109
2110 a = NIL;
2111 for (pp = sp; consp(*pp) ; *pp = cdr(*pp)) {
2112 push(car(*pp));
2113 *pp = cdr(*pp);
2114 if ( atom(*pp) ) {
2115 error("Odd number of args to setq",NON);
2116 /* NOTREACHED */
2117 }
2118 push(car(*pp));
2119 push(Leval(1));
2120 a = Lset(2);
2121 }
2122 pop1();
2123 return(a);
2124 }
2125
2126 static int equal();
2127
2128 static list
Lequal(n)2129 Lequal(n)
2130 int n;
2131 {
2132 argnchk("equal (=)",2);
2133 if (equal(pop1(),pop1()))
2134 return(T);
2135 else
2136 return(NIL);
2137 }
2138
2139 /* null ʸ���ǽ����ʤ� strncmp */
2140
2141 static int
Strncmp(x,y,len)2142 Strncmp(x, y, len)
2143 char *x, *y;
2144 int len;
2145 {
2146 int i;
2147
2148 for (i = 0 ; i < len ; i++) {
2149 if (x[i] != y[i]) {
2150 return (x[i] - y[i]);
2151 }
2152 }
2153 return 0;
2154 }
2155
2156 /* null ʸ���ǽ����ʤ� strncpy */
2157
2158 static char *
Strncpy(x,y,len)2159 Strncpy(x, y, len)
2160 char *x, *y;
2161 int len;
2162 {
2163 int i;
2164
2165 for (i = 0 ; i < len ; i++) {
2166 x[i] = y[i];
2167 }
2168 return x;
2169 }
2170
2171 static int
equal(x,y)2172 equal(x,y)
2173 list x, y;
2174 {
2175 equaltop:
2176 if (x == y)
2177 return(YES);
2178 else if (null(x) || null(y))
2179 return(NO);
2180 else if (numberp(x) || numberp(y)) {
2181 return NO;
2182 }
2183 else if (stringp(x)) {
2184 if (stringp(y)) {
2185 return ((xstrlen(x) == xstrlen(y)) ?
2186 (!Strncmp(xstring(x), xstring(y), xstrlen(x))) : 0);
2187 }
2188 else {
2189 return NO;
2190 }
2191 }
2192 else if (symbolp(x) || symbolp(y)) {
2193 return(NO);
2194 }
2195 else {
2196 if (equal(car(x), car(y))) {
2197 x = cdr(x);
2198 y = cdr(y);
2199 goto equaltop;
2200 }
2201 else
2202 return(NO);
2203 }
2204 }
2205
2206 static list
Lgreaterp(n)2207 Lgreaterp(n)
2208 int n;
2209 {
2210 list p;
2211 pointerint x, y;
2212
2213 if ( !n )
2214 return(T);
2215 else {
2216 p = pop1();
2217 if (!numberp(p)) {
2218 numerr("greaterp",p);
2219 /* NOTREACHED */
2220 }
2221 x = xnum(p);
2222 for (n-- ; n ; n--) {
2223 p = pop1();
2224 if (!numberp(p)) {
2225 numerr("greaterp",p);
2226 /* NOTREACHED */
2227 }
2228 y = xnum(p);
2229 if (y <= x) /* !(y > x) */
2230 return(NIL);
2231 x = y;
2232 }
2233 return(T);
2234 }
2235 }
2236
2237 static list
Llessp(n)2238 Llessp(n)
2239 int n;
2240 {
2241 list p;
2242 pointerint x, y;
2243
2244 if ( !n )
2245 return(T);
2246 else {
2247 p = pop1();
2248 if (!numberp(p)) {
2249 numerr("lessp",p);
2250 /* NOTREACHED */
2251 }
2252 x = xnum(p);
2253 for (n-- ; n ; n--) {
2254 p = pop1();
2255 if (!numberp(p)) {
2256 numerr("lessp",p);
2257 /* NOTREACHED */
2258 }
2259 y = xnum(p);
2260 if (y >= x) /* !(y < x) */
2261 return(NIL);
2262 x = y;
2263 }
2264 return(T);
2265 }
2266 }
2267
2268 static list
Leq(n)2269 Leq(n)
2270 int n;
2271 {
2272 list f;
2273
2274 argnchk("eq",2);
2275 f = pop1();
2276 if (f == pop1())
2277 return(T);
2278 else
2279 return(NIL);
2280 }
2281
2282 static list
Lcond()2283 Lcond()
2284 {
2285 list *pp, t, a, c;
2286
2287 pp = sp;
2288 for (; consp(*pp) ; *pp = cdr(*pp)) {
2289 t = car(*pp);
2290 if (atom(t)) {
2291 pop1();
2292 return (NIL);
2293 }
2294 else {
2295 push(cdr(t));
2296 if ((c = car(t)) == T || (push(c), (a = Leval(1)))) {
2297 /* if non NIL */
2298 t = pop1();
2299 if (null(t)) { /* if cdr is NIL */
2300 (void)pop1();
2301 return (a);
2302 }
2303 else {
2304 (void)pop1();
2305 push(t);
2306 return(Lprogn());
2307 }
2308 }
2309 else {
2310 (void)pop1();
2311 }
2312 }
2313 }
2314 pop1();
2315 return (NIL);
2316 }
2317
2318 static list
Lnull(n)2319 Lnull(n)
2320 int n;
2321 {
2322 argnchk("null",1);
2323 if (pop1())
2324 return NIL;
2325 else
2326 return T;
2327 }
2328
2329 static list
Lor()2330 Lor()
2331 {
2332 list *pp, t;
2333
2334 for (pp = sp; consp(*pp) ; *pp = cdr(*pp)) {
2335 push(car(*pp));
2336 t = Leval(1);
2337 if (t) {
2338 pop1();
2339 return(t);
2340 }
2341 }
2342 pop1();
2343 return(NIL);
2344 }
2345
2346 static list
Land()2347 Land()
2348 {
2349 list *pp, t;
2350
2351 t = T;
2352 for (pp = sp; consp(*pp) ; *pp = cdr(*pp)) {
2353 push(car(*pp));
2354 if ( !(t = Leval(1)) ) {
2355 pop1();
2356 return(NIL);
2357 }
2358 }
2359 pop1();
2360 return(t);
2361 }
2362
2363 static list
Lplus(n)2364 Lplus(n)
2365 int n;
2366 {
2367 list t;
2368 int i;
2369 pointerint sum;
2370
2371 i = n;
2372 sum = 0;
2373 while (i--) {
2374 t = sp[i];
2375 if ( !numberp(t) ) {
2376 numerr("+",t);
2377 /* NOTREACHED */
2378 }
2379 else {
2380 sum += xnum(t);
2381 }
2382 }
2383 pop(n);
2384 return(mknum(sum));
2385 }
2386
2387 static list
Ltimes(n)2388 Ltimes(n)
2389 int n;
2390 {
2391 list t;
2392 int i;
2393 pointerint sum;
2394
2395 i = n;
2396 sum = 1;
2397 while (i--) {
2398 t = sp[i];
2399 if ( !numberp(t) ) {
2400 numerr("*",t);
2401 /* NOTREACHED */
2402 }
2403 else
2404 sum *= xnum(t);
2405 }
2406 pop(n);
2407 return(mknum(sum));
2408 }
2409
2410 static list
Ldiff(n)2411 Ldiff(n)
2412 int n;
2413 {
2414 list t;
2415 int i;
2416 pointerint sum;
2417
2418 if ( !n )
2419 return(mknum(0));
2420 t = sp[n - 1];
2421 if ( !numberp(t) ) {
2422 numerr("-",t);
2423 /* NOTREACHED */
2424 }
2425 sum = xnum(t);
2426 if (n == 1) {
2427 pop1();
2428 return(mknum(-sum));
2429 }
2430 else {
2431 i = n - 1;
2432 while (i--) {
2433 t = sp[i];
2434 if ( !numberp(t) ) {
2435 numerr("-",t);
2436 /* NOTREACHED */
2437 }
2438 else
2439 sum -= xnum(t);
2440 }
2441 pop(n);
2442 return(mknum(sum));
2443 }
2444 }
2445
2446 static list
Lquo(n)2447 Lquo(n)
2448 int n;
2449 {
2450 list t;
2451 int i;
2452 pointerint sum;
2453
2454 if ( !n )
2455 return(mknum(1));
2456 t = sp[n - 1];
2457 if ( !numberp(t) ) {
2458 numerr("/",t);
2459 /* NOTREACHED */
2460 }
2461 sum = xnum(t);
2462 i = n - 1;
2463 while (i--) {
2464 t = sp[i];
2465 if ( !numberp(t) ) {
2466 numerr("/",t);
2467 /* NOTREACHED */
2468 }
2469 else if (xnum(t) != 0) {
2470 sum = sum / (pointerint)xnum(t); /* CP/M68K is bad... */
2471 }
2472 else { /* division by zero */
2473 error("Division by zero",NON);
2474 }
2475 }
2476 pop(n);
2477 return(mknum(sum));
2478 }
2479
2480 static list
Lrem(n)2481 Lrem(n)
2482 int n;
2483 {
2484 list t;
2485 int i;
2486 pointerint sum;
2487
2488 if ( !n )
2489 return(mknum(0));
2490 t = sp[n - 1];
2491 if ( !numberp(t) ) {
2492 numerr("%",t);
2493 /* NOTREACHED */
2494 }
2495 sum = xnum(t);
2496 i = n - 1;
2497 while (i--) {
2498 t = sp[i];
2499 if ( !numberp(t) ) {
2500 numerr("%",t);
2501 /* NOTREACHED */
2502 }
2503 else if (xnum(t) != 0) {
2504 sum = sum % (pointerint)xnum(t); /* CP/M68K is bad .. */
2505 }
2506 else { /* division by zero */
2507 error("Division by zero",NON);
2508 }
2509 }
2510 pop(n);
2511 return(mknum(sum));
2512 }
2513
2514 /*
2515 * Garbage Collection
2516 */
2517
2518 static list
Lgc(n)2519 Lgc(n)
2520 int n;
2521 {
2522 argnchk("gc",0);
2523 gc();
2524 return(NIL);
2525 }
2526
2527 static list
Lusedic(n)2528 Lusedic(n)
2529 int n;
2530 {
2531 int i;
2532 list retval = NIL, temp;
2533 int dictype;
2534 extern struct dicname *kanjidicnames;
2535 struct dicname *kanjidicname;
2536 extern int auto_define;
2537 extern char *kataautodic;
2538 #ifdef HIRAGANAAUTO
2539 extern char *hiraautodic;
2540 #endif
2541
2542 for (i = n ; i ; i--) {
2543 temp = sp[i - 1];
2544 dictype = DIC_PLAIN;
2545 if (symbolp(temp) && i - 1 > 0) {
2546 if (temp == USER) {
2547 dictype = DIC_USER;
2548 }
2549 else if (temp == BUSHU) {
2550 dictype = DIC_BUSHU;
2551 }
2552 else if (temp == GRAMMAR) {
2553 dictype = DIC_GRAMMAR;
2554 }
2555 else if (temp == RENGO) {
2556 dictype = DIC_RENGO;
2557 }
2558 else if (temp == KATAKANA) {
2559 dictype = DIC_KATAKANA;
2560 auto_define = 1;
2561 }
2562 else if (temp == HIRAGANA) {
2563 dictype = DIC_HIRAGANA;
2564 }
2565 i--; temp = sp[i - 1];
2566 }
2567 if (stringp(temp)) {
2568 kanjidicname = (struct dicname *)malloc(sizeof(struct dicname));
2569 if (kanjidicname) {
2570 kanjidicname->name = malloc(strlen(xstring(temp)) + 1);
2571 if (kanjidicname->name) {
2572 strcpy(kanjidicname->name , xstring(temp));
2573 kanjidicname->dictype = dictype;
2574 kanjidicname->dicflag = DIC_NOT_MOUNTED;
2575 kanjidicname->next = kanjidicnames;
2576 kanjidicnames = kanjidicname;
2577 if (kanjidicname->dictype == DIC_KATAKANA) {
2578 if (!kataautodic) { /* only the first one is valid */
2579 kataautodic = kanjidicname->name;
2580 }
2581 }
2582 #ifdef HIRAGANAAUTO
2583 else if (kanjidicname->dictype == DIC_HIRAGANA) {
2584 if (!hiraautodic) { /* only the first one is valid */
2585 hiraautodic = kanjidicname->name;
2586 }
2587 }
2588 #endif
2589 retval = T;
2590 continue;
2591 }
2592 free((char *)kanjidicname);
2593 }
2594 }
2595 }
2596 pop(n);
2597 return retval;
2598 }
2599
2600 static list
Llist(n)2601 Llist(n)
2602 int n;
2603 {
2604 push(NIL);
2605 for (; n ; n--) {
2606 push(Lcons(2));
2607 }
2608 return (pop1());
2609 }
2610
2611 static list
Lcopysym(n)2612 Lcopysym(n)
2613 int n;
2614 {
2615 list src, dst;
2616 struct atomcell *dsta, *srca;
2617
2618 argnchk("copy-symbol",2);
2619 src = pop1();
2620 dst = pop1();
2621 if (!symbolp(dst)) {
2622 error("copy-symbol: bad arg ", dst);
2623 /* NOTREACHED */
2624 }
2625 if (!symbolp(src)) {
2626 error("copy-symbol: bad arg ", src);
2627 /* NOTREACHED */
2628 }
2629 dsta = symbolpointer(dst);
2630 srca = symbolpointer(src);
2631 dsta->plist = srca->plist;
2632 dsta->value = srca->value;
2633 dsta->ftype = srca->ftype;
2634 dsta->func = srca->func;
2635 dsta->valfunc = srca->valfunc;
2636 dsta->mid = srca->mid;
2637 dsta->fid = srca->fid;
2638 return src;
2639 }
2640
2641 static list
Lload(n)2642 Lload(n)
2643 int n;
2644 {
2645 list p, t;
2646 FILE *instream, *fopen();
2647
2648 argnchk("load",1);
2649 p = pop1();
2650 if ( !stringp(p) ) {
2651 error("load: illegal file name ",p);
2652 /* NOTREACHED */
2653 }
2654 if ((instream = fopen(xstring(p), "r")) == (FILE *)NULL) {
2655 error("load: file not found ",p);
2656 /* NOTREACHED */
2657 }
2658 prins("[load ");
2659 print(p);
2660 prins("]\n");
2661
2662 if (jmpenvp <= 0) { /* �Ƶ������������� */
2663 return NIL;
2664 }
2665 jmpenvp--;
2666 files[++filep].f = instream;
2667 files[filep].name = malloc(xstrlen(p) + 1);
2668 if (files[filep].name) {
2669 strcpy(files[filep].name, xstring(p));
2670 }
2671 files[filep].line = 0;
2672
2673 setjmp(env[jmpenvp].jmp_env);
2674 env[jmpenvp].base_stack = sp - stack;
2675 env[jmpenvp].base_estack = esp - estack;
2676
2677 for (;;) {
2678 t = Lread(0);
2679 if (valuec > 1 && null(values[1])) {
2680 break;
2681 }
2682 else {
2683 push(t);
2684 Leval(1);
2685 }
2686 }
2687 jmpenvp++;
2688 return(T);
2689 }
2690
2691 static list
Lmodestr(n)2692 Lmodestr(n)
2693 int n;
2694 {
2695 list p;
2696 int mode;
2697
2698 argnchk(S_SetModeDisp, 2);
2699 if ( !null(p = sp[0]) && !stringp(p) ) {
2700 lisp_strerr(S_SetModeDisp, p);
2701 /* NOTREACHED */
2702 }
2703 if (!symbolp(sp[1]) || (mode = symbolpointer(sp[1])->mid) == -1) {
2704 error("Illegal mode ", sp[1]);
2705 /* NOTREACHED */
2706 }
2707 changeModeName(mode, null(p) ? 0 : xstring(p));
2708 pop(2);
2709 return p;
2710 }
2711
2712 /* ��ǽ���������μ��Ф� */
2713
2714 static int
xfseq(fname,l,arr,arrsize)2715 xfseq(fname, l, arr, arrsize)
2716 char *fname;
2717 list l;
2718 unsigned char *arr;
2719 int arrsize;
2720 {
2721 int i;
2722
2723 if (atom(l)) {
2724 if (symbolp(l) &&
2725 (arr[0] = (unsigned char)(symbolpointer(l)->fid)) != 255) {
2726 arr[1] = 0;
2727 }
2728 else {
2729 prins(fname);
2730 error(": illegal function ", l);
2731 /* NOTREACHED */
2732 }
2733 return 1;
2734 }
2735 else {
2736 for (i = 0 ; i < arrsize - 1 && consp(l) ; i++, l = cdr(l)) {
2737 list temp = car(l);
2738
2739 if (!symbolp(temp) ||
2740 (arr[i] = (unsigned char)(symbolpointer(temp)->fid)) == 255) {
2741 prins(fname);
2742 error(": illegal function ", temp);
2743 /* NOTREACHED */
2744 }
2745 }
2746 arr[i] = 0;
2747 return i;
2748 }
2749 }
2750
2751 static list
Lsetkey(n)2752 Lsetkey(n)
2753 int n;
2754 {
2755 list p;
2756 int mode, slen;
2757 unsigned char fseq[256];
2758 unsigned char keyseq[256];
2759 int retval;
2760
2761 argnchk(S_SetKey, 3);
2762 if ( !stringp(p = sp[1]) ) {
2763 lisp_strerr(S_SetKey, p);
2764 /* NOTREACHED */
2765 }
2766 if (!symbolp(sp[2]) || (mode = symbolpointer(sp[2])->mid) < 0 ||
2767 (CANNA_MODE_MAX_REAL_MODE <= mode &&
2768 mode < CANNA_MODE_MAX_IMAGINARY_MODE &&
2769 mode != CANNA_MODE_HenkanNyuryokuMode)) {
2770 error("Illegal mode for set-key ", sp[2]);
2771 /* NOTREACHED */
2772 }
2773 if (xfseq(S_SetKey, sp[0], fseq, 256)) {
2774 slen = xstrlen(p);
2775 Strncpy((char *)keyseq, xstring(p), slen);
2776 keyseq[slen] = 255;
2777 retval = changeKeyfunc(mode, (unsigned)keyseq[0],
2778 slen > 1 ? CANNA_FN_UseOtherKeymap :
2779 (fseq[1] != 0 ? CANNA_FN_FuncSequence : fseq[0]),
2780 fseq, keyseq);
2781 if (retval == NG) {
2782 error("Insufficient memory.", NON);
2783 /* NOTREACHED */
2784 }
2785 }
2786 pop(3);
2787 return p;
2788 }
2789
2790 static list
Lgsetkey(n)2791 Lgsetkey(n)
2792 int n;
2793 {
2794 list p;
2795 int slen;
2796 unsigned char fseq[256];
2797 unsigned char keyseq[256];
2798 int retval;
2799
2800 argnchk(S_GSetKey, 2);
2801 if ( !stringp(p = sp[1]) ) {
2802 lisp_strerr(S_GSetKey, p);
2803 /* NOTREACHED */
2804 }
2805 if (xfseq(S_GSetKey, sp[0], fseq, 256)) {
2806 slen = xstrlen(p);
2807 Strncpy((char *)keyseq, xstring(p), slen);
2808 keyseq[slen] = 255;
2809 retval = changeKeyfuncOfAll((unsigned)keyseq[0],
2810 slen > 1 ? CANNA_FN_UseOtherKeymap :
2811 (fseq[1] != 0 ? CANNA_FN_FuncSequence : fseq[0]),
2812 fseq, keyseq);
2813 if (retval == NG) {
2814 error("Insufficient memory.", NON);
2815 /* NOTREACHED */
2816 }
2817 pop(2);
2818 return p;
2819 }
2820 else {
2821 pop(2);
2822 return NIL;
2823 }
2824 }
2825
2826 static list
Lputd(n)2827 Lputd(n)
2828 int n;
2829 {
2830 list body, a;
2831 list sym;
2832 struct atomcell *symp;
2833
2834 argnchk("putd",2);
2835 a = body = pop1();
2836 sym = pop1();
2837 symp = symbolpointer(sym);
2838 if (constp(sym) || consp(sym)) {
2839 error("putd: function name must be a symbol : ",sym);
2840 /* NOTREACHED */
2841 }
2842 if (null(body)) {
2843 symp->ftype = UNDEF;
2844 symp->func = (list (*)())UNDEF;
2845 }
2846 else if (consp(body)) {
2847 if (car(body) == _MACRO) {
2848 symp->ftype = MACRO;
2849 symp->func = (list (*)())body;
2850 }
2851 else {
2852 symp->ftype = EXPR;
2853 symp->func = (list (*)())body;
2854 }
2855 }
2856 return(a);
2857 }
2858
2859 static list
Ldefun()2860 Ldefun()
2861 {
2862 list form, res;
2863
2864 form = sp[0];
2865 if (atom(form)) {
2866 error("defun: illegal form ",form);
2867 /* NOTREACHED */
2868 }
2869 push(car(form));
2870 push(_LAMBDA);
2871 push(cdr(form));
2872 push(Lcons(2));
2873 Lputd(2);
2874 res = car(pop1());
2875 return (res);
2876 }
2877
2878 static list
Ldefmacro()2879 Ldefmacro()
2880 {
2881 list form, res;
2882
2883 form = sp[0];
2884 if (atom(form)) {
2885 error("defmacro: illegal form ",form);
2886 /* NOTREACHED */
2887 }
2888 push(res = car(form));
2889 push(_MACRO);
2890 push(cdr(form));
2891 push(Lcons(2));
2892 Lputd(2);
2893 pop1();
2894 return (res);
2895 }
2896
2897 static list
Lcar(n)2898 Lcar(n)
2899 int n;
2900 {
2901 list f;
2902
2903 argnchk("car",1);
2904 f = pop1();
2905 if (!f)
2906 return(NIL);
2907 else if (atom(f)) {
2908 error("Bad arg to car ",f);
2909 /* NOTREACHED */
2910 }
2911 return(car(f));
2912 }
2913
2914 static list
Lcdr(n)2915 Lcdr(n)
2916 int n;
2917 {
2918 list f;
2919
2920 argnchk("cdr",1);
2921 f = pop1();
2922 if (!f)
2923 return(NIL);
2924 else if (atom(f)) {
2925 error("Bad arg to cdr ",f);
2926 /* NOTREACHED */
2927 }
2928 return(cdr(f));
2929 }
2930
2931 static list
Latom(n)2932 Latom(n)
2933 int n;
2934 {
2935 list f;
2936
2937 argnchk("atom",1);
2938 f = pop1();
2939 if (atom(f))
2940 return(T);
2941 else
2942 return(NIL);
2943 }
2944
2945 static list
Llet()2946 Llet()
2947 {
2948 list lambda, args, p, *pp, *pq, *pl, *px;
2949
2950 px = sp;
2951 *px = cdr(*px);
2952 if (atom(*px)) {
2953 (void)pop1();
2954 return(NIL);
2955 }
2956 else {
2957 push(NIL);
2958 args = Lncons(1);
2959 push(args); pq = sp;
2960 push(NIL);
2961 lambda = p = Lncons(1);
2962 push(lambda);
2963
2964 push(p); pp = sp;
2965 push(*pq); pq = sp;
2966 push(NIL); pl = sp;
2967 for (*pl = car(*px) ; consp(*pl) ; *pl = cdr(*pl)) {
2968 if (atom(car(*pl))) {
2969 push(car(*pl));
2970 *pp = cdr(*pp) = Lncons(1);
2971 push(NIL);
2972 *pq = cdr(*pq) = Lncons(1);
2973 }
2974 else if (atom(cdar(*pl))) {
2975 push(caar(*pl));
2976 *pp = cdr(*pp) = Lncons(1);
2977 push(NIL);
2978 *pq = cdr(*pq) = Lncons(1);
2979 }
2980 else {
2981 push(caar(*pl));
2982 *pp = cdr(*pp) = Lncons(1);
2983 push(cadr(car(*pl)));
2984 *pq = cdr(*pq) = Lncons(1);
2985 }
2986 }
2987 pop(3);
2988 sp[0] = cdr(sp[0]);
2989 sp[1] = cdr(sp[1]);
2990 push(cdr(*px));
2991 push(Lcons(2));
2992 push(_LAMBDA);
2993 push(Lxcons(2));
2994 p = Lxcons(2);
2995 (void)pop1();
2996 return(p);
2997 }
2998 }
2999
3000 /* (if con tr . falist) -> (cond (con tr) (t . falist))*/
3001
3002 static list
Lif()3003 Lif()
3004 {
3005 list x, *px, retval;
3006
3007 x = cdr(sp[0]);
3008 if (atom(x) || atom(cdr(x))) {
3009 (void)pop1();
3010 return NIL;
3011 }
3012 else {
3013 push(x); px = sp;
3014
3015 push(COND);
3016
3017 push(car(x));
3018 push(cadr(x));
3019 push(Llist(2));
3020
3021 push(T);
3022 push(cddr(*px));
3023 push(Lcons(2));
3024
3025 retval = Llist(3);
3026 pop(2);
3027 return retval;
3028 }
3029 }
3030
3031 static list
Lunbindkey(n)3032 Lunbindkey(n)
3033 int n;
3034 {
3035 unsigned char fseq[2];
3036 static unsigned char keyseq[2] = {(unsigned char)CANNA_KEY_Undefine,
3037 (unsigned char)255};
3038 int mode;
3039 list retval;
3040
3041 argnchk(S_UnbindKey, 2);
3042 if (!symbolp(sp[1]) || (mode = symbolpointer(sp[1])->mid) == -1) {
3043 error("Illegal mode ", sp[1]);
3044 /* NOTREACHED */
3045 }
3046 if (xfseq(S_UnbindKey, sp[0], fseq, 2)) {
3047 int ret;
3048 ret = changeKeyfunc(mode, CANNA_KEY_Undefine,
3049 fseq[1] != 0 ? CANNA_FN_FuncSequence : fseq[0],
3050 fseq, keyseq);
3051 if (ret == NG) {
3052 error("Insufficient memory.", NON);
3053 /* NOTREACHED */
3054 }
3055 retval = T;
3056 }
3057 else {
3058 retval = NIL;
3059 }
3060 pop(2);
3061 return retval;
3062 }
3063
3064 static list
Lgunbindkey(n)3065 Lgunbindkey(n)
3066 int n;
3067 {
3068 unsigned char fseq[2];
3069 static unsigned char keyseq[2] = {(unsigned char)CANNA_KEY_Undefine,
3070 (unsigned char)255};
3071 list retval;
3072
3073 argnchk(S_GUnbindKey, 1);
3074 if (xfseq(S_GUnbindKey, sp[0], fseq, 2)) {
3075 int ret;
3076 ret = changeKeyfuncOfAll(CANNA_KEY_Undefine,
3077 fseq[1] != 0 ? CANNA_FN_FuncSequence : fseq[0],
3078 fseq, keyseq);
3079 if (ret == NG) {
3080 error("Insufficient memory.", NON);
3081 /* NOTREACHED */
3082 }
3083 retval = T;
3084 }
3085 else {
3086 retval = NIL;
3087 }
3088 (void)pop1();
3089 return retval;
3090 }
3091
3092 #define DEFMODE_MEMORY 0
3093 #define DEFMODE_NOTSTRING 1
3094 #define DEFMODE_ILLFUNCTION 2
3095
3096 static list
Ldefmode()3097 Ldefmode()
3098 {
3099 list form, *sym, e, *p, fn, rd, md, us;
3100 extern extraFunc *extrafuncp;
3101 extern int nothermodes;
3102 extraFunc *extrafunc = (extraFunc *)0;
3103 int i, j;
3104 int ecode;
3105 list l, edata;
3106
3107 form = pop1();
3108 if (atom(form)) {
3109 error("Bad form ", form);
3110 /* NOTREACHED */
3111 }
3112 push(car(form));
3113 sym = sp;
3114 if (!symbolp(*sym)) {
3115 error("Symbol data expected ", *sym);
3116 /* NOTREACHED */
3117 }
3118
3119 /* ������ץå��夹�� */
3120 for (i = 0, e = cdr(form) ; i < 4 ; i++, e = cdr(e)) {
3121 if (atom(e)) {
3122 for (j = i ; j < 4 ; j++) {
3123 push(NIL);
3124 }
3125 break;
3126 }
3127 push(car(e));
3128 }
3129 if (consp(e)) {
3130 error("Bad form ", form);
3131 /* NOTREACHED */
3132 }
3133
3134 /* ɾ������ */
3135 for (i = 0, p = sym - 1 ; i < 4 ; i++, p--) {
3136 push(*p);
3137 push(Leval(1));
3138 }
3139 us = pop1();
3140 fn = pop1();
3141 rd = pop1();
3142 md = pop1();
3143 pop(4);
3144
3145 ecode = DEFMODE_MEMORY;
3146 extrafunc = (extraFunc *)malloc(sizeof(extraFunc));
3147 if (extrafunc) {
3148 /* ����ܥ�δؿ��ͤȤ��Ƥ���� */
3149 symbolpointer(*sym)->mid = CANNA_MODE_MAX_IMAGINARY_MODE + nothermodes;
3150 symbolpointer(*sym)->fid =
3151 extrafunc->fnum = CANNA_FN_MAX_FUNC + nothermodes;
3152
3153 /* �ǥե���Ȥ����� */
3154 extrafunc->display_name = (wchar_t *)NULL;
3155 extrafunc->u.modeptr = (newmode *)malloc(sizeof(newmode));
3156 if (extrafunc->u.modeptr) {
3157 KanjiMode kanjimode;
3158
3159 extrafunc->u.modeptr->romaji_table = (char *)0;
3160 extrafunc->u.modeptr->romdic = (struct RkRxDic *)0;
3161 extrafunc->u.modeptr->romdic_owner = 0;
3162 extrafunc->u.modeptr->flags = CANNA_YOMI_IGNORE_USERSYMBOLS;
3163 extrafunc->u.modeptr->emode = (KanjiMode)0;
3164
3165 /* �⡼�ɹ�¤�Τκ��� */
3166 kanjimode = (KanjiMode)malloc(sizeof(KanjiModeRec));
3167 if (kanjimode) {
3168 int searchfunc();
3169 extern KanjiModeRec empty_mode;
3170 extern BYTE *emptymap;
3171
3172 kanjimode->func = searchfunc;
3173 kanjimode->keytbl = emptymap;
3174 kanjimode->flags =
3175 CANNA_KANJIMODE_TABLE_SHARED | CANNA_KANJIMODE_EMPTY_MODE;
3176 kanjimode->ftbl = empty_mode.ftbl;
3177 extrafunc->u.modeptr->emode = kanjimode;
3178
3179 /* �⡼��ɽ��ʸ���� */
3180 ecode = DEFMODE_NOTSTRING;
3181 edata = md;
3182 if (stringp(md) || null(md)) {
3183 if (stringp(md)) {
3184 extrafunc->display_name = WString(xstring(md));
3185 }
3186 ecode = DEFMODE_MEMORY;
3187 if (null(md) || extrafunc->display_name) {
3188 /* ���������Ѵ��ơ��֥� */
3189 ecode = DEFMODE_NOTSTRING;
3190 edata = rd;
3191 if (stringp(rd) || null(rd)) {
3192 char *newstr;
3193 long f = extrafunc->u.modeptr->flags;
3194
3195 if (stringp(rd)) {
3196 newstr = malloc(strlen(xstring(rd)) + 1);
3197 }
3198 ecode = DEFMODE_MEMORY;
3199 if (null(rd) || newstr) {
3200 if (!null(rd)) {
3201 strcpy(newstr, xstring(rd));
3202 extrafunc->u.modeptr->romaji_table = newstr;
3203 }
3204 /* �¹Ե�ǽ */
3205 for (e = fn ; consp(e) ; e = cdr(e)) {
3206 l = car(e);
3207 if (symbolp(l) && symbolpointer(l)->fid) {
3208 switch (symbolpointer(l)->fid) {
3209 case CANNA_FN_Kakutei:
3210 f |= CANNA_YOMI_KAKUTEI;
3211 break;
3212 case CANNA_FN_Henkan:
3213 f |= CANNA_YOMI_HENKAN;
3214 break;
3215 case CANNA_FN_Zenkaku:
3216 f |= CANNA_YOMI_ZENKAKU;
3217 break;
3218 case CANNA_FN_Hankaku:
3219 f |= CANNA_YOMI_HANKAKU;
3220 break;
3221 case CANNA_FN_Hiragana:
3222 f |= CANNA_YOMI_HIRAGANA;
3223 break;
3224 case CANNA_FN_Katakana:
3225 f |= CANNA_YOMI_KATAKANA;
3226 break;
3227 case CANNA_FN_Romaji:
3228 f |= CANNA_YOMI_ROMAJI;
3229 break;
3230 /* �ʲ��Ϥ��Τ������ */
3231 case CANNA_FN_ToUpper:
3232 break;
3233 case CANNA_FN_Capitalize:
3234 break;
3235 case CANNA_FN_ToLower:
3236 break;
3237 default:
3238 goto defmode_not_function;
3239 }
3240 }
3241 else {
3242 goto defmode_not_function;
3243 }
3244 }
3245 extrafunc->u.modeptr->flags = f;
3246
3247 /* �桼������ܥ�λ��Ѥ�̵ͭ */
3248 if (us) {
3249 extrafunc->u.modeptr->flags &=
3250 ~CANNA_YOMI_IGNORE_USERSYMBOLS;
3251 }
3252
3253 extrafunc->keyword = EXTRA_FUNC_DEFMODE;
3254 extrafunc->next = extrafuncp;
3255 extrafuncp = extrafunc;
3256 nothermodes++;
3257 return pop1();
3258
3259 defmode_not_function:
3260 ecode = DEFMODE_ILLFUNCTION;
3261 edata = l;
3262 if (!null(rd)) {
3263 free(newstr);
3264 }
3265 }
3266 }
3267 if (extrafunc->display_name) {
3268 WSfree(extrafunc->display_name);
3269 }
3270 }
3271 }
3272 free((char *)kanjimode);
3273 }
3274 free((char *)extrafunc->u.modeptr);
3275 }
3276 free((char *)extrafunc);
3277 }
3278 switch (ecode) {
3279 case DEFMODE_MEMORY:
3280 error("Insufficient memory", NON);
3281 case DEFMODE_NOTSTRING:
3282 error("String data expected ", edata);
3283 case DEFMODE_ILLFUNCTION:
3284 error("defmode: illegal subfunction ", edata);
3285 }
3286 /* NOTREACHED */
3287 }
3288
3289 static list
Ldefsym()3290 Ldefsym()
3291 {
3292 list form, res, e;
3293 int i, ncand, group;
3294 wchar_t cand[1024], *p, *mcand, **acand, key, xkey;
3295 int mcandsize;
3296 extern nkeysup;
3297 extern keySupplement keysup[];
3298
3299 form = sp[0];
3300 if (atom(form)) {
3301 error("Illegal form ",form);
3302 /* NOTREACHED */
3303 }
3304 /* �ޤ����������� */
3305 for (ncand = 0 ; consp(form) ; ) {
3306 e = car(form);
3307 if (!numberp(e)) {
3308 error("Key data expected ", e);
3309 /* NOTREACHED */
3310 }
3311 if (null(cdr(form))) {
3312 error("Illegal form ",sp[0]);
3313 /* NOTREACHED */
3314 }
3315 if (numberp(car(cdr(form)))) {
3316 form = cdr(form);
3317 }
3318 for (i = 0, form = cdr(form) ; consp(form) ; i++, form = cdr(form)) {
3319 e = car(form);
3320 if (!stringp(e)) {
3321 break;
3322 }
3323 }
3324 if (ncand == 0) {
3325 ncand = i;
3326 }
3327 else if (ncand != i) {
3328 error("Inconsist number for each key definition ", sp[0]);
3329 /* NOTREACHED */
3330 }
3331 }
3332
3333 group = nkeysup;
3334
3335 for (form = sp[0] ; consp(form) ;) {
3336 if (nkeysup >= MAX_KEY_SUP) {
3337 error("Too many symbol definitions", sp[0]);
3338 /* NOTREACHED */
3339 }
3340 /* The following lines are for xkey translation rule */
3341 key = (wchar_t)xnum(car(form));
3342 if (numberp(car(cdr(form)))) {
3343 xkey = (wchar_t)xnum(car(cdr(form)));
3344 form = cdr(form);
3345 }
3346 else {
3347 xkey = key;
3348 }
3349 p = cand;
3350 for (form = cdr(form) ; consp(form) ; form = cdr(form)) {
3351 int len;
3352
3353 e = car(form);
3354 if (!stringp(e)) {
3355 break;
3356 }
3357 len = MBstowcs(p, xstring(e), 1024 - (p - cand));
3358 p += len;
3359 *p++ = (wchar_t)0;
3360 }
3361 *p++ = (wchar_t)0;
3362 mcandsize = p - cand;
3363 mcand = (wchar_t *)malloc(mcandsize * sizeof(wchar_t));
3364 if (mcand == 0) {
3365 error("Insufficient memory", NON);
3366 /* NOTREACHED */
3367 }
3368 acand = (wchar_t **)calloc(ncand + 1, sizeof(wchar_t *));
3369 if (acand == 0) {
3370 free(mcand);
3371 error("Insufficient memory", NON);
3372 /* NOTREACHED */
3373 }
3374
3375 for (i = 0 ; i < p - cand ; i++) {
3376 mcand[i] = cand[i];
3377 }
3378 for (i = 0, p = mcand ; i < ncand ; i++) {
3379 acand[i] = p;
3380 while (*p++)
3381 /* EMPTY */
3382 ;
3383 }
3384 acand[i] = 0;
3385 /* �ºݤ˳�Ǽ���� */
3386 keysup[nkeysup].key = key;
3387 keysup[nkeysup].xkey = xkey;
3388 keysup[nkeysup].groupid = group;
3389 keysup[nkeysup].ncand = ncand;
3390 keysup[nkeysup].cand = acand;
3391 keysup[nkeysup].fullword = mcand;
3392 nkeysup++;
3393 }
3394 res = car(pop1());
3395 return (res);
3396 }
3397
3398 #ifndef NO_EXTEND_MENU
3399
3400 /*
3401 defselection �ǰ�����ʸ������Ф������ɬ�פʤΤǡ��ʲ����������
3402 */
3403
3404 #define SS2 ((char)0x8e)
3405 #define SS3 ((char)0x8f)
3406
3407 #define G0 0
3408 #define G1 1
3409 #define G2 2
3410 #define G3 3
3411
3412 static int cswidth[4] = {1, 2, 2, 3};
3413
3414
3415 /*
3416 getKutenCode -- ʸ���ζ��������ɤ���Ф�
3417 */
3418
3419 static int
getKutenCode(data,ku,ten)3420 getKutenCode(data, ku, ten)
3421 char *data;
3422 int *ku, *ten;
3423 {
3424 int codeset;
3425
3426 *ku = (data[0] & 0x7f) - 0x20;
3427 *ten = (data[1] & 0x7f) - 0x20;
3428 if (*data == SS2) {
3429 codeset = G2;
3430 *ku = 0;
3431 }
3432 else if (*data == SS3) {
3433 codeset = G3;
3434 *ku = *ten;
3435 *ten = (data[2] & 0x7f) - 0x20;
3436 }
3437 else if (*data & 0x80) {
3438 codeset = G1;
3439 }
3440 else {
3441 codeset = G0;
3442 *ten = *ku;
3443 *ku = 0;
3444 }
3445 return codeset;
3446 }
3447
3448 /*
3449 howManuCharsAre -- defselection ���ϰϻ��ꤷ������
3450 �����ϰ���ο�ʸ���θĿ����֤�
3451 */
3452
3453 static int
howManyCharsAre(tdata,edata,tku,tten,codeset)3454 howManyCharsAre(tdata, edata, tku, tten, codeset)
3455 char *tdata, *edata;
3456 int *tku, *tten, *codeset;
3457 {
3458 int eku, eten, kosdata, koedata;
3459
3460 kosdata = getKutenCode(tdata, tku, tten);
3461 koedata = getKutenCode(edata, &eku, &eten);
3462 if (kosdata != koedata) {
3463 return 0;
3464 }
3465 else {
3466 *codeset = kosdata;
3467 return ((eku - *tku) * 94 + eten - *tten + 1);
3468 }
3469 }
3470
3471
3472 /*
3473 pickupChars -- �ϰ���ο�ʸ������Ф�
3474 */
3475
3476 static char *
pickupChars(tku,tten,num,kodata)3477 pickupChars(tku, tten, num, kodata)
3478 int tku, tten, num, kodata;
3479 {
3480 char *dptr, *tdptr, *edptr;
3481
3482 dptr = (char *)malloc(num * cswidth[kodata] + 1);
3483 if (dptr) {
3484 tdptr = dptr;
3485 edptr = dptr + num * cswidth[kodata];
3486 for (; dptr < edptr ; tten++) {
3487 if (tten > 94) {
3488 tku++;
3489 tten = 1;
3490 }
3491 switch(kodata) {
3492 case G0:
3493 *dptr++ = (tten + 0x20);
3494 break;
3495 case G1:
3496 *dptr++ = (tku + 0x20) | 0x80;
3497 *dptr++ = (tten + 0x20) | 0x80;
3498 break;
3499 case G2:
3500 *dptr++ = SS2;
3501 *dptr++ = (tten + 0x20) | 0x80;
3502 break;
3503 case G3:
3504 *dptr++ = SS3;
3505 *dptr++ = (tku + 0x20) | 0x80;
3506 *dptr++ = (tten + 0x20) | 0x80;
3507 break;
3508 default:
3509 break;
3510 }
3511 }
3512 *dptr++ = '\0';
3513 return tdptr;
3514 }
3515 else {
3516 error("Insufficient memory", NON);
3517 /* NOTREACHED */
3518 }
3519 }
3520
3521 /*
3522 numtostr -- Key data ����ʸ������Ф�
3523 */
3524
3525 static void
numtostr(num,str)3526 numtostr(num, str)
3527 unsigned long num;
3528 char *str;
3529 {
3530 if (num & 0xff0000) {
3531 *str++ = (char)((num >> 16) & 0xff);
3532 }
3533 if (num & 0xff00) {
3534 *str++ = (char)((num >> 8) & 0xff);
3535 }
3536 *str++ = (char)(num & 0xff);
3537 *str = '\0';
3538 }
3539
3540 /*
3541 defselection -- ʸ�����������
3542
3543 �Է�����
3544 (defselection function-symbol "�⡼��ɽ��" '(character-list))
3545 */
3546
3547 static list
Ldefselection()3548 Ldefselection()
3549 {
3550 list form, sym, e, e2, md, kigo_list, buf;
3551 extern extraFunc *extrafuncp;
3552 extern int nothermodes;
3553 int i, len, cs, nkigo_data = 0, kigolen = 0;
3554 wchar_t *p, *kigo_str, **akigo_data;
3555 extraFunc *extrafunc = (extraFunc *)0;
3556
3557 form = sp[0];
3558
3559 if (atom(form) || atom(cdr(form)) || atom(cdr(cdr(form)))) {
3560 error("Illegal form ",form);
3561 /* NOTREACHED */
3562 }
3563
3564 sym = car(form);
3565 if (!symbolp(sym)) {
3566 error("Symbol data expected ", sym);
3567 /* NOTREACHED */
3568 }
3569
3570 md = car(cdr(form));
3571 if (!stringp(md) && !null(md)) {
3572 error("String data expected ", md);
3573 /* NOTREACHED */
3574 }
3575
3576 push(car(cdr(cdr(form))));
3577 push(Leval(1));
3578
3579 kigo_list = sp[0];
3580 if (atom(kigo_list)) {
3581 error("Illegal form ", kigo_list);
3582 /* NOTREACHED */
3583 }
3584
3585 /* �ޤ��ΰ����ݤ��� */
3586 buf = kigo_list;
3587 while (!atom(buf)) {
3588 if (!atom(cdr(buf)) && (car(cdr(buf)) == HYPHEN)) {
3589 /* �ϰϻ���ΤȤ� */
3590 if (atom(cdr(cdr(buf)))) {
3591 error("Illegal form ", buf);
3592 /* NOTREACHED */
3593 }
3594 else {
3595 int sku, sten, num;
3596 char ss[4], ee[4];
3597
3598 e = car(buf);
3599 if (!numberp(e)) {
3600 error("Key data expected ", e);
3601 /* NOTREACHED */
3602 }
3603 e2 = car(cdr(cdr(buf)));
3604 if (!numberp(e2)) {
3605 error("Key data expected ", e2);
3606 /* NOTREACHED */
3607 }
3608
3609 numtostr(xnum(e), ss);
3610 numtostr(xnum(e2), ee);
3611 num = howManyCharsAre(ss, ee, &sku, &sten, &cs);
3612 if (num <= 0) {
3613 error("Inconsistent range of charcter code ", buf);
3614 /* NOTREACHED */
3615 }
3616 kigolen = kigolen + (cswidth[cs] + 1) * num;
3617 nkigo_data += num;
3618 }
3619 buf = cdr(cdr(cdr(buf)));
3620 }
3621 else {
3622 /* ���ǻ���ΤȤ� */
3623 char xx[4], *xxp;
3624
3625 e = car(buf);
3626 if (!numberp(e) && !stringp(e)) {
3627 error("Key or string data expected ", e);
3628 /* NOTREACHED */
3629 }
3630 else if (numberp(e)) {
3631 numtostr(xnum(e), xx);
3632 xxp = xx;
3633 }
3634 else {
3635 xxp = xstring(e);
3636 }
3637
3638 for ( ; *xxp ; xxp += cswidth[cs] ) {
3639 if (*xxp == SS2) {
3640 cs = G2;
3641 }
3642 else if (*xxp == SS3) {
3643 cs = G3;
3644 }
3645 else if (*xxp & 0x80) {
3646 cs = G1;
3647 }
3648 else {
3649 cs = G0;
3650 }
3651 kigolen = kigolen + cswidth[cs];
3652 }
3653 kigolen += 1; /* �����ǤκǸ�� \0 ������� */
3654 nkigo_data++;
3655 buf = cdr(buf);
3656 }
3657 }
3658
3659 kigo_str = (wchar_t *)malloc(kigolen * sizeof(wchar_t));
3660 if (!kigo_str) {
3661 error("Insufficient memory ", NON);
3662 /* NOTREACHED */
3663 }
3664 p = kigo_str;
3665
3666 /* ��������� */
3667 while (!atom(kigo_list)) {
3668 if (!atom(cdr(kigo_list)) && (car(cdr(kigo_list)) == HYPHEN)) {
3669 /* �ϰϻ���ΤȤ� */
3670 int sku, sten, codeset, num;
3671 char *ww, *sww, *eww, ss[4], ee[4], bak;
3672
3673 e = car(kigo_list);
3674 e2 = car(cdr(cdr(kigo_list)));
3675 numtostr(xnum(e), ss);
3676 numtostr(xnum(e2), ee);
3677 num = howManyCharsAre(ss, ee, &sku, &sten, &codeset);
3678 sww = ww = pickupChars(sku, sten, num, codeset);
3679 cs = cswidth[codeset];
3680 eww = ww + num * cs;
3681 while (ww < eww) {
3682 bak = ww[cs];
3683 ww[cs] = '\0';
3684 len = MBstowcs(p, ww, kigolen - (p - kigo_str));
3685 p += len;
3686 *p++ = (wchar_t)0;
3687 ww += cs;
3688 ww[0] = bak;
3689 }
3690 free(sww);
3691 kigo_list = cdr(cdr(cdr(kigo_list)));
3692 }
3693 else {
3694 /* ���ǻ���ΤȤ� */
3695 char xx[4], *xxp;
3696
3697 e = car(kigo_list);
3698 if (numberp(e)) {
3699 numtostr(xnum(e), xx);
3700 xxp = xx;
3701 }
3702 else {
3703 xxp = xstring(e);
3704 }
3705 len = MBstowcs(p, xxp, kigolen - (p - kigo_str));
3706 p += len;
3707 *p++ = (wchar_t)0;
3708 kigo_list = cdr(kigo_list);
3709 }
3710 }
3711
3712 akigo_data = (wchar_t **)calloc(nkigo_data + 1, sizeof(wchar_t *));
3713 if (akigo_data == 0) {
3714 free(kigo_str);
3715 error("Insufficient memory", NON);
3716 /* NOTREACHED */
3717 }
3718
3719 for (i = 0, p = kigo_str ; i < nkigo_data ; i++) {
3720 akigo_data[i] = p;
3721 while (*p++)
3722 /* EMPTY */
3723 ;
3724 }
3725
3726 /* �ΰ����ݤ��� */
3727 extrafunc = (extraFunc *)malloc(sizeof(extraFunc));
3728 if (!extrafunc) {
3729 free((char *)kigo_str);
3730 free((char *)akigo_data);
3731 error("Insufficient memory", NON);
3732 /* NOTREACHED */
3733 }
3734 extrafunc->u.kigoptr = (kigoIchiran *)malloc(sizeof(kigoIchiran));
3735 if (!extrafunc->u.kigoptr) {
3736 free((char *)kigo_str);
3737 free((char *)akigo_data);
3738 free((char *)extrafunc);
3739 error("Insufficient memory", NON);
3740 /* NOTREACHED */
3741 }
3742
3743 /* ����ܥ�δؿ��ͤȤ��Ƥ���� */
3744 symbolpointer(sym)->mid = extrafunc->u.kigoptr->kigo_mode
3745 = CANNA_MODE_MAX_IMAGINARY_MODE + nothermodes;
3746 symbolpointer(sym)->fid = extrafunc->fnum
3747 = CANNA_FN_MAX_FUNC + nothermodes;
3748
3749 /* �ºݤ˳�Ǽ���� */
3750 extrafunc->u.kigoptr->kigo_data = akigo_data;
3751 extrafunc->u.kigoptr->kigo_str = kigo_str;
3752 extrafunc->u.kigoptr->kigo_size = nkigo_data;
3753 if (stringp(md)) {
3754 extrafunc->display_name = WString(xstring(md));
3755 }
3756 else {
3757 extrafunc->display_name = (wchar_t *)0;
3758 }
3759
3760 extrafunc->keyword = EXTRA_FUNC_DEFSELECTION;
3761 extrafunc->next = extrafuncp;
3762 extrafuncp = extrafunc;
3763 pop(2);
3764 nothermodes++;
3765 return sym;
3766 }
3767
3768 /*
3769 defmenu -- ��˥塼�����
3770
3771 �Է�����
3772 (defmenu first-menu
3773 ("��Ͽ" touroku)
3774 ("���������" server))
3775 */
3776
3777 static list
Ldefmenu()3778 Ldefmenu()
3779 {
3780 list form, sym, e;
3781 extern extraFunc *extrafuncp;
3782 extern int nothermodes;
3783 extraFunc *extrafunc = (extraFunc *)0;
3784 int i, n, clen, len;
3785 wchar_t foo[512];
3786 menustruct *men;
3787 menuitem *menubody;
3788 wchar_t *wp, **wpp;
3789 extern menustruct *allocMenu();
3790
3791 form = sp[0];
3792 if (atom(form) || atom(cdr(form))) {
3793 error("Bad form ", form);
3794 /* NOTREACHED */
3795 }
3796 sym = car(form);
3797 if (!symbolp(sym)) {
3798 error("Symbol data expected ", sym);
3799 /* NOTREACHED */
3800 }
3801
3802 /* ����������롣�Ĥ��Ǥ�ɽ��ʸ�����ʸ����������� */
3803 for (n = 0, clen = 0, e = cdr(form) ; !atom(e) ; n++, e = cdr(e)) {
3804 list l = car(e), d, fn;
3805 if (atom(l) || atom(cdr(l))) {
3806 error("Bad form ", form);
3807 }
3808 d = car(l);
3809 fn = car(cdr(l));
3810 if (!stringp(d) || !symbolp(fn)) {
3811 error("Bad form ", form);
3812 }
3813 len = MBstowcs(foo, xstring(d), 512);
3814 if (len >= 0) {
3815 clen += len + 1;
3816 }
3817 }
3818
3819 extrafunc = (extraFunc *)malloc(sizeof(extraFunc));
3820 if (extrafunc) {
3821 men = allocMenu(n, clen);
3822 if (men) {
3823 menubody = men->body;
3824 /* �����ȥ�ʸ����ǡ����Хåե��˥��ԡ� */
3825 for (i = 0, wp = men->titledata, wpp = men->titles, e = cdr(form) ;
3826 i < n ; i++, e = cdr(e)) {
3827 len = MBstowcs(wp, xstring(car(car(e))), 512);
3828 *wpp++ = wp;
3829 wp += len + 1;
3830
3831 menubody[i].flag = MENU_SUSPEND;
3832 menubody[i].u.misc = (char *)car(cdr(car(e)));
3833 }
3834 men->nentries = n;
3835
3836 /* ����ܥ�δؿ��ͤȤ��Ƥ���� */
3837 symbolpointer(sym)->mid =
3838 men->modeid = CANNA_MODE_MAX_IMAGINARY_MODE + nothermodes;
3839 symbolpointer(sym)->fid =
3840 extrafunc->fnum = CANNA_FN_MAX_FUNC + nothermodes;
3841 extrafunc->keyword = EXTRA_FUNC_DEFMENU;
3842 extrafunc->display_name = (wchar_t *)0;
3843 extrafunc->u.menuptr = men;
3844
3845 extrafunc->next = extrafuncp;
3846 extrafuncp = extrafunc;
3847 nothermodes++;
3848 (void)pop1();
3849 return sym;
3850 }
3851 free((char *)extrafunc);
3852 }
3853 error("Insufficient memory", NON);
3854 /* NOTREACHED */
3855 }
3856 #endif /* NO_EXTEND_MENU */
3857
3858 static list
Lsetinifunc(n)3859 Lsetinifunc(n)
3860 int n;
3861 {
3862 unsigned char fseq[256];
3863 int i, len;
3864 list ret = NIL;
3865 extern BYTE *initfunc;
3866
3867 argnchk(S_SetInitFunc, 1);
3868
3869 len = xfseq(S_SetInitFunc, sp[0], fseq, 256);
3870
3871 if (len > 0) {
3872 if (initfunc) free(initfunc);
3873 initfunc = (BYTE *)malloc(len + 1);
3874 if (!initfunc) {
3875 error("Insufficient memory", NON);
3876 /* NOTREACHED */
3877 }
3878 for (i = 0 ; i < len ; i++) {
3879 initfunc[i] = fseq[i];
3880 }
3881 initfunc[i] = 0;
3882 ret = T;
3883 }
3884 (void)pop1();
3885 return ret;
3886 }
3887
3888 static list
Lboundp(n)3889 Lboundp(n)
3890 int n;
3891 {
3892 list e;
3893 struct atomcell *sym;
3894
3895 argnchk("boundp",1);
3896 e = pop1();
3897
3898 if (!atom(e)) {
3899 error("boundp: bad arg ", e);
3900 /* NOTREACHED */
3901 }
3902 else if (constp(e)) {
3903 error("boundp: bad arg ", e);
3904 /* NOTREACHED */
3905 }
3906
3907 if (assq(e, *esp)) {
3908 return T;
3909 }
3910 else if ((sym = symbolpointer(e))->valfunc) {
3911 return T;
3912 }
3913 else {
3914 if (sym->value != (list)UNBOUND) {
3915 return T;
3916 }
3917 else {
3918 return NIL;
3919 }
3920 }
3921 }
3922
3923 static list
Lfboundp(n)3924 Lfboundp(n)
3925 int n;
3926 {
3927 list e;
3928
3929 argnchk("fboundp",1);
3930 e = pop1();
3931
3932 if (!atom(e)) {
3933 error("fboundp: bad arg ", e);
3934 /* NOTREACHED */
3935 }
3936 else if (constp(e)) {
3937 error("fboundp: bad arg ", e);
3938 /* NOTREACHED */
3939 }
3940 if (symbolpointer(e)->ftype == UNDEF) {
3941 return NIL;
3942 }
3943 else {
3944 return T;
3945 }
3946 }
3947
3948 static list
Lgetenv(n)3949 Lgetenv(n)
3950 int n;
3951 {
3952 list e;
3953 char strbuf[256], *ret, *getenv();
3954 list retval;
3955
3956 argnchk("getenv",1);
3957 e = sp[0];
3958
3959 if (!stringp(e)) {
3960 error("getenv: bad arg ", e);
3961 /* NOTREACHED */
3962 }
3963
3964 strncpy(strbuf, xstring(e), xstrlen(e));
3965 strbuf[xstrlen(e)] = '\0';
3966 ret = getenv(strbuf);
3967 if (ret) {
3968 retval = copystring(ret, strlen(ret));
3969 }
3970 else {
3971 retval = NIL;
3972 }
3973 (void)pop1();
3974 return retval;
3975 }
3976
3977 static list
LdefEscSeq(n)3978 LdefEscSeq(n)
3979 int n;
3980 {
3981 extern void (*keyconvCallback)();
3982
3983 argnchk("define-esc-sequence",3);
3984
3985 if (!stringp(sp[2])) {
3986 error("define-esc-sequence: bad arg ", sp[2]);
3987 /* NOTREACHED */
3988 }
3989 if (!stringp(sp[1])) {
3990 error("define-esc-sequence: bad arg ", sp[1]);
3991 /* NOTREACHED */
3992 }
3993 if (!numberp(sp[0])) {
3994 error("define-esc-sequence: bad arg ", sp[0]);
3995 /* NOTREACHED */
3996 }
3997 if (keyconvCallback) {
3998 (*keyconvCallback)(CANNA_CTERMINAL,
3999 xstring(sp[2]), xstring(sp[1]), xnum(sp[0]));
4000 }
4001 pop(3);
4002 return NIL;
4003 }
4004
4005 static list
Lconcat(n)4006 Lconcat(n)
4007 int n;
4008 {
4009 list t, res;
4010 int i, len;
4011 char *p;
4012
4013 /* �ޤ�Ĺ��������롣 */
4014 for (len= 0, i = n ; i-- ;) {
4015 t = sp[i];
4016 if (!stringp(t)) {
4017 lisp_strerr("concat", t);
4018 /* NOTREACHED */
4019 }
4020 len += xstrlen(t);
4021 }
4022 res = allocstring(len);
4023 for (p = xstring(res), i = n ; i-- ;) {
4024 t = sp[i];
4025 len = xstrlen(t);
4026 Strncpy(p, xstring(t), len);
4027 p += len;
4028 }
4029 *p = '\0';
4030 pop(n);
4031 return res;
4032 }
4033
4034 /* lispfuncend */
4035
4036 extern char *RkGetServerHost();
4037
4038 static void
ObtainVersion()4039 ObtainVersion()
4040 {
4041 #if !defined(STANDALONE) && !defined(WIN_CANLISP)
4042 int a, b;
4043 char *serv;
4044 extern int protocol_version, server_version;
4045 extern char *server_name;
4046
4047 serv = RkGetServerHost();
4048 if (!serv) {
4049 serv = DICHOME;
4050 }
4051 RkwInitialize(serv);
4052
4053 /* �ץ�ȥ���С������ */
4054 RkwGetProtocolVersion(&a, &b);
4055 protocol_version = a * 1000 + b;
4056
4057 /* �����ХС������ */
4058 RkwGetServerVersion(&a, &b);
4059 server_version = a * 1000 + b;
4060
4061 /* ������̾ */
4062 if (server_name)
4063 free(server_name);
4064 server_name = malloc(strlen(DEFAULT_CANNA_SERVER_NAME) + 1);
4065 if (server_name) {
4066 strcpy(server_name, DEFAULT_CANNA_SERVER_NAME);
4067 }
4068
4069 RkwFinalize();
4070 #endif /* STANDALONE */
4071 }
4072
4073 /* �ѿ����������Τ���δؿ� */
4074
4075 static list
VTorNIL(var,setp,arg)4076 VTorNIL(var, setp, arg)
4077 BYTE *var;
4078 int setp;
4079 list arg;
4080 {
4081 if (setp == VALSET) {
4082 *var = (arg == NIL) ? 0 : 1;
4083 return arg;
4084 }
4085 else { /* get */
4086 return *var ? T : NIL;
4087 }
4088 }
4089
4090 static list
StrAcc(var,setp,arg)4091 StrAcc(var, setp, arg)
4092 char **var;
4093 int setp;
4094 list arg;
4095 {
4096 if (setp == VALSET) {
4097 if (null(arg) || stringp(arg)) {
4098 if (*var) {
4099 free(*var);
4100 }
4101 if (stringp(arg)) {
4102 *var = malloc(strlen(xstring(arg)) + 1);
4103 if (*var) {
4104 strcpy(*var, xstring(arg));
4105 return arg;
4106 }
4107 else {
4108 error("Insufficient memory.", NON);
4109 /* NOTREACHED */
4110 }
4111 }
4112 else {
4113 *var = (char *)0;
4114 return NIL;
4115 }
4116 }
4117 else {
4118 lisp_strerr((char *)0, arg);
4119 /* NOTREACHED */
4120 }
4121 }
4122 /* else { .. */
4123 if (*var) {
4124 return copystring(*var, strlen(*var));
4125 }
4126 else {
4127 return NIL;
4128 }
4129 /* end else .. } */
4130 }
4131
4132 static list
NumAcc(var,setp,arg)4133 NumAcc(var, setp, arg)
4134 int *var;
4135 int setp;
4136 list arg;
4137 {
4138 if (setp == VALSET) {
4139 if (numberp(arg)) {
4140 *var = (int)xnum(arg);
4141 return arg;
4142 }
4143 else {
4144 numerr((char *)0, arg);
4145 /* NOTREACHED */
4146 }
4147 }
4148 return (list)mknum(*var);
4149 }
4150
4151 /* �������鲼���������ޥ������ɲ������ɤ���������ʬ */
4152
4153 /* �ºݤΥ��������ؿ� */
4154
4155 #define DEFVAR(fn, acc, ty, var) \
4156 static list fn(setp, arg) int setp; list arg; { \
4157 extern ty var; return acc(&var, setp, arg); }
4158
4159 #define DEFVAREX(fn, acc, var) \
4160 static list fn(setp, arg) int setp; list arg; { \
4161 extern struct CannaConfig cannaconf; return acc(&var, setp, arg); }
4162
Vnkouhobunsetsu(setp,arg)4163 static list Vnkouhobunsetsu(setp, arg) int setp; list arg;
4164 {
4165 extern int nKouhoBunsetsu;
4166
4167 arg = NumAcc(&nKouhoBunsetsu, setp, arg);
4168 #ifdef RESTRICT_NKOUHOBUNSETSU
4169 if (nKouhoBunsetsu < 3 || nKouhoBunsetsu > 60)
4170 nKouhoBunsetsu = 16;
4171 #else
4172 if (nKouhoBunsetsu < 0) {
4173 nKouhoBunsetsu = 0;
4174 }
4175 #endif
4176 return arg;
4177 }
4178
VProtoVer(setp,arg)4179 static list VProtoVer(setp, arg) int setp; list arg;
4180 {
4181 #ifndef STANDALONE
4182 extern protocol_version;
4183
4184 if (protocol_version < 0) {
4185 ObtainVersion();
4186 }
4187 return NumAcc(&protocol_version, setp, arg);
4188 #endif /* STANDALONE */
4189 }
4190
VServVer(setp,arg)4191 static list VServVer(setp, arg) int setp; list arg;
4192 {
4193 #ifndef STANDALONE
4194 extern server_version;
4195
4196 if (server_version < 0) {
4197 ObtainVersion();
4198 }
4199 return NumAcc(&server_version, setp, arg);
4200 #endif /* STANDALONE */
4201 }
4202
VServName(setp,arg)4203 static list VServName(setp, arg) int setp; list arg;
4204 {
4205 #ifndef STANDALONE
4206 extern char *server_name;
4207
4208 if (!server_name) {
4209 ObtainVersion();
4210 }
4211 return StrAcc(&server_name, setp, arg);
4212 #endif /* STANDALONE */
4213 }
4214
4215 static list
VCannaDir(setp,arg)4216 VCannaDir(setp, arg) int setp; list arg;
4217 {
4218 char *canna_dir = CANNALIBDIR;
4219
4220 if (setp == VALGET) {
4221 return StrAcc(&canna_dir, setp, arg);
4222 }
4223 else {
4224 return NIL;
4225 }
4226 }
4227
VCodeInput(setp,arg)4228 static list VCodeInput(setp, arg) int setp; list arg;
4229 {
4230 extern struct CannaConfig cannaconf;
4231 static char *input_code[CANNA_MAX_CODE] = {"jis", "sjis", "kuten"};
4232
4233 if (setp == VALSET) {
4234 if (null(arg) || stringp(arg)) {
4235 if (stringp(arg)) {
4236 int i;
4237 char *s = xstring(arg);
4238
4239 for (i = 0 ; i < CANNA_MAX_CODE ; i++) {
4240 if (!strcmp(s, input_code[i])) {
4241 cannaconf.code_input = i;
4242 break;
4243 }
4244 }
4245 if (i < CANNA_MAX_CODE) {
4246 return arg;
4247 }
4248 else {
4249 return NIL;
4250 }
4251 }
4252 else {
4253 cannaconf.code_input = 0; /* use default */
4254 return copystring(input_code[0], strlen(input_code[0]));
4255 }
4256 }
4257 else {
4258 lisp_strerr((char *)0, arg);
4259 /* NOTREACHED */
4260 }
4261 }
4262 /* else { .. */
4263 if (/* 0 <= cannaconf.code_input && /* unsigned �ˤ����ΤǾ�Ĺ�ˤʤä� */
4264 cannaconf.code_input <= CANNA_CODE_KUTEN) {
4265 return copystring(input_code[cannaconf.code_input],
4266 strlen(input_code[cannaconf.code_input]));
4267 }
4268 else {
4269 return NIL;
4270 }
4271 /* end else .. } */
4272 }
4273
4274
4275 DEFVAR(Vromkana ,StrAcc ,char * ,RomkanaTable)
4276 DEFVAR(Venglish ,StrAcc ,char * ,EnglishTable)
4277
4278 DEFVAREX(Vnhenkan ,NumAcc ,cannaconf.kouho_threshold)
4279 DEFVAREX(Vndisconnect ,NumAcc ,cannaconf.strokelimit)
4280 DEFVAREX(VCannaVersion ,NumAcc ,cannaconf.CannaVersion)
4281 DEFVAREX(VIndexSeparator,NumAcc ,cannaconf.indexSeparator)
4282
4283 DEFVAREX(Vgakushu ,VTorNIL ,cannaconf.Gakushu)
4284 DEFVAREX(Vcursorw ,VTorNIL ,cannaconf.CursorWrap)
4285 DEFVAREX(Vselectd ,VTorNIL ,cannaconf.SelectDirect)
4286 DEFVAREX(Vnumeric ,VTorNIL ,cannaconf.HexkeySelect)
4287 DEFVAREX(Vbunsets ,VTorNIL ,cannaconf.BunsetsuKugiri)
4288 DEFVAREX(Vcharact ,VTorNIL ,cannaconf.ChBasedMove)
4289 DEFVAREX(Vreverse ,VTorNIL ,cannaconf.ReverseWidely)
4290 DEFVAREX(VreverseWord ,VTorNIL ,cannaconf.ReverseWord)
4291 DEFVAREX(Vquitich ,VTorNIL ,cannaconf.QuitIchiranIfEnd)
4292 DEFVAREX(Vkakutei ,VTorNIL ,cannaconf.kakuteiIfEndOfBunsetsu)
4293 DEFVAREX(Vstayaft ,VTorNIL ,cannaconf.stayAfterValidate)
4294 DEFVAREX(Vbreakin ,VTorNIL ,cannaconf.BreakIntoRoman)
4295 DEFVAREX(Vgrammati ,VTorNIL ,cannaconf.grammaticalQuestion)
4296 DEFVAREX(Vforceka ,VTorNIL ,cannaconf.forceKana)
4297 DEFVAREX(Vkouhoco ,VTorNIL ,cannaconf.kCount)
4298 DEFVAREX(Vauto ,VTorNIL ,cannaconf.chikuji)
4299 DEFVAREX(VlearnNumTy ,VTorNIL ,cannaconf.LearnNumericalType)
4300 DEFVAREX(VBSasQuit ,VTorNIL ,cannaconf.BackspaceBehavesAsQuit)
4301 DEFVAREX(Vinhibi ,VTorNIL ,cannaconf.iListCB)
4302 DEFVAREX(Vkeepcupos ,VTorNIL ,cannaconf.keepCursorPosition)
4303 DEFVAREX(VAbandon ,VTorNIL ,cannaconf.abandonIllegalPhono)
4304 DEFVAREX(VHexStyle ,VTorNIL ,cannaconf.hexCharacterDefiningStyle)
4305 DEFVAREX(VKojin ,VTorNIL ,cannaconf.kojin)
4306 DEFVAREX(VIndexHankaku ,VTorNIL ,cannaconf.indexHankaku)
4307 DEFVAREX(VAllowNext ,VTorNIL ,cannaconf.allowNextInput)
4308 DEFVAREX(VkanaGaku ,VTorNIL ,cannaconf.doKatakanaGakushu)
4309 DEFVAREX(VhiraGaku ,VTorNIL ,cannaconf.doHiraganaGakushu)
4310 DEFVAREX(VChikujiContinue ,VTorNIL ,cannaconf.ChikujiContinue)
4311 DEFVAREX(VRenbunContinue ,VTorNIL ,cannaconf.RenbunContinue)
4312 DEFVAREX(VMojishuContinue ,VTorNIL ,cannaconf.MojishuContinue)
4313 DEFVAREX(VcRealBS ,VTorNIL ,cannaconf.chikujiRealBackspace)
4314 DEFVAREX(VIgnoreCase ,VTorNIL ,cannaconf.ignore_case)
4315 DEFVAREX(VRomajiYuusen ,VTorNIL ,cannaconf.romaji_yuusen)
4316 DEFVAREX(VAutoSync ,VTorNIL ,cannaconf.auto_sync)
4317 DEFVAREX(VQuicklyEscape ,VTorNIL ,cannaconf.quickly_escape)
4318 DEFVAREX(VInhibitHankana,VTorNIL ,cannaconf.InhibitHankakuKana)
4319 DEFVAREX(VDelayConnect ,VTorNIL ,cannaconf.DelayConnect)
4320
4321 #ifdef DEFINE_SOMETHING
4322 DEFVAR(Vchikuji_debug, VTorNIL, int, chikuji_debug)
4323 #endif
4324
4325 /* Lisp �δؿ��� C �δؿ����б�ɽ */
4326
4327 static struct atomdefs initatom[] = {
4328 {"quote" ,SPECIAL,Lquote },
4329 {"setq" ,SPECIAL,Lsetq },
4330 {"set" ,SUBR ,Lset },
4331 {"equal" ,SUBR ,Lequal },
4332 {"=" ,SUBR ,Lequal },
4333 {">" ,SUBR ,Lgreaterp },
4334 {"<" ,SUBR ,Llessp },
4335 {"progn" ,SPECIAL,Lprogn },
4336 {"eq" ,SUBR ,Leq },
4337 {"cond" ,SPECIAL,Lcond },
4338 {"null" ,SUBR ,Lnull },
4339 {"not" ,SUBR ,Lnull },
4340 {"and" ,SPECIAL,Land },
4341 {"or" ,SPECIAL,Lor },
4342 {"+" ,SUBR ,Lplus },
4343 {"-" ,SUBR ,Ldiff },
4344 {"*" ,SUBR ,Ltimes },
4345 {"/" ,SUBR ,Lquo },
4346 {"%" ,SUBR ,Lrem },
4347 {"gc" ,SUBR ,Lgc },
4348 {"load" ,SUBR ,Lload },
4349 {"list" ,SUBR ,Llist },
4350 {"sequence" ,SUBR ,Llist },
4351 {"defun" ,SPECIAL,Ldefun },
4352 {"defmacro" ,SPECIAL,Ldefmacro },
4353 {"cons" ,SUBR ,Lcons },
4354 {"car" ,SUBR ,Lcar },
4355 {"cdr" ,SUBR ,Lcdr },
4356 {"atom" ,SUBR ,Latom },
4357 {"let" ,CMACRO ,Llet },
4358 {"if" ,CMACRO ,Lif },
4359 {"boundp" ,SUBR ,Lboundp },
4360 {"fboundp" ,SUBR ,Lfboundp },
4361 {"getenv" ,SUBR ,Lgetenv },
4362 {"copy-symbol" ,SUBR ,Lcopysym },
4363 {"concat" ,SUBR ,Lconcat },
4364 {S_FN_UseDictionary ,SUBR ,Lusedic },
4365 {S_SetModeDisp ,SUBR ,Lmodestr },
4366 {S_SetKey ,SUBR ,Lsetkey },
4367 {S_GSetKey ,SUBR ,Lgsetkey },
4368 {S_UnbindKey ,SUBR ,Lunbindkey },
4369 {S_GUnbindKey ,SUBR ,Lgunbindkey },
4370 {S_DefMode ,SPECIAL,Ldefmode },
4371 {S_DefSymbol ,SPECIAL,Ldefsym },
4372 #ifndef NO_EXTEND_MENU
4373 {S_DefSelection ,SPECIAL,Ldefselection },
4374 {S_DefMenu ,SPECIAL,Ldefmenu },
4375 #endif
4376 {S_SetInitFunc ,SUBR ,Lsetinifunc },
4377 {S_defEscSequence ,SUBR ,LdefEscSeq },
4378 {0 ,UNDEF ,0 }, /* DUMMY */
4379 };
4380
4381 static void
deflispfunc()4382 deflispfunc()
4383 {
4384 struct atomdefs *p;
4385
4386 for (p = initatom ; p->symname ; p++) {
4387 struct atomcell *atomp;
4388 list temp;
4389
4390 temp = getatmz(p->symname);
4391 atomp = symbolpointer(temp);
4392 atomp->ftype = p->symtype;
4393 if (atomp->ftype != UNDEF) {
4394 atomp->func = p->symfunc;
4395 }
4396 }
4397 }
4398
4399
4400 /* �ѿ�ɽ */
4401
4402 static struct cannavardefs cannavars[] = {
4403 {S_VA_RomkanaTable ,Vromkana},
4404 {S_VA_EnglishTable ,Venglish},
4405 {S_VA_CursorWrap ,Vcursorw},
4406 {S_VA_SelectDirect ,Vselectd},
4407 {S_VA_NumericalKeySelect ,Vnumeric},
4408 {S_VA_BunsetsuKugiri ,Vbunsets},
4409 {S_VA_CharacterBasedMove ,Vcharact},
4410 {S_VA_ReverseWidely ,Vreverse},
4411 {S_VA_ReverseWord ,VreverseWord},
4412 {S_VA_Gakushu ,Vgakushu},
4413 {S_VA_QuitIfEOIchiran ,Vquitich},
4414 {S_VA_KakuteiIfEOBunsetsu ,Vkakutei},
4415 {S_VA_StayAfterValidate ,Vstayaft},
4416 {S_VA_BreakIntoRoman ,Vbreakin},
4417 {S_VA_NHenkanForIchiran ,Vnhenkan},
4418 {S_VA_GrammaticalQuestion ,Vgrammati},
4419 {"gramatical-question" ,Vgrammati}, /* �����Υ��ڥ�ߥ��εߺ� */
4420 {S_VA_ForceKana ,Vforceka},
4421 {S_VA_KouhoCount ,Vkouhoco},
4422 {S_VA_Auto ,Vauto},
4423 {S_VA_LearnNumericalType ,VlearnNumTy},
4424 {S_VA_BackspaceBehavesAsQuit ,VBSasQuit},
4425 {S_VA_InhibitListCallback ,Vinhibi},
4426 {S_VA_nKouhoBunsetsu ,Vnkouhobunsetsu},
4427 {S_VA_keepCursorPosition ,Vkeepcupos},
4428 {S_VA_CannaVersion ,VCannaVersion},
4429 {S_VA_Abandon ,VAbandon},
4430 {S_VA_HexDirect ,VHexStyle},
4431 {S_VA_ProtocolVersion ,VProtoVer},
4432 {S_VA_ServerVersion ,VServVer},
4433 {S_VA_ServerName ,VServName},
4434 {S_VA_CannaDir ,VCannaDir},
4435 {S_VA_Kojin ,VKojin},
4436 {S_VA_IndexHankaku ,VIndexHankaku},
4437 {S_VA_IndexSeparator ,VIndexSeparator},
4438 {S_VA_AllowNextInput ,VAllowNext},
4439 {S_VA_doKatakanaGakushu ,VkanaGaku},
4440 {S_VA_doHiraganaGakushu ,VhiraGaku},
4441 #ifdef DEFINE_SOMETHING
4442 {S_VA_chikuji_debug ,Vchikuji_debug},
4443 #endif /* DEFINE_SOMETHING */
4444 {S_VA_ChikujiContinue ,VChikujiContinue},
4445 {S_VA_RenbunContinue ,VRenbunContinue},
4446 {S_VA_MojishuContinue ,VMojishuContinue},
4447 {S_VA_ChikujiRealBackspace ,VcRealBS},
4448 {S_VA_nDisconnectServer ,Vndisconnect},
4449 {S_VA_ignoreCase ,VIgnoreCase},
4450 {S_VA_RomajiYuusen ,VRomajiYuusen},
4451 {S_VA_AutoSync ,VAutoSync},
4452 {S_VA_QuicklyEscape ,VQuicklyEscape},
4453 {S_VA_InhibitHanKana ,VInhibitHankana},
4454 {S_VA_CodeInput ,VCodeInput},
4455 {S_VA_DelayConnect ,VDelayConnect},
4456 {0 ,0},
4457 };
4458
4459 static void
defcannavar()4460 defcannavar()
4461 {
4462 struct cannavardefs *p;
4463
4464 for (p = cannavars ; p->varname ; p++) {
4465 symbolpointer(getatmz(p->varname))->valfunc = p->varfunc;
4466 }
4467 }
4468
4469
4470
4471 /* �⡼��ɽ */
4472
4473 static struct cannamodedefs cannamodes[] = {
4474 {S_AlphaMode ,CANNA_MODE_AlphaMode},
4475 {S_YomiganaiMode ,CANNA_MODE_EmptyMode},
4476 {S_YomiMode ,CANNA_MODE_YomiMode},
4477 {S_MojishuMode ,CANNA_MODE_JishuMode},
4478 {S_TankouhoMode ,CANNA_MODE_TankouhoMode},
4479 {S_IchiranMode ,CANNA_MODE_IchiranMode},
4480 {S_KigouMode ,CANNA_MODE_KigoMode},
4481 {S_YesNoMode ,CANNA_MODE_YesNoMode},
4482 {S_OnOffMode ,CANNA_MODE_OnOffMode},
4483 {S_ShinshukuMode ,CANNA_MODE_AdjustBunsetsuMode},
4484
4485 {S_AutoYomiMode ,CANNA_MODE_ChikujiYomiMode},
4486 {S_AutoBunsetsuMode ,CANNA_MODE_ChikujiTanMode},
4487
4488 {S_HenkanNyuuryokuMode ,CANNA_MODE_HenkanNyuryokuMode},
4489 {S_HexMode ,CANNA_MODE_HexMode},
4490 {S_BushuMode ,CANNA_MODE_BushuMode},
4491 {S_ExtendMode ,CANNA_MODE_ExtendMode},
4492 {S_RussianMode ,CANNA_MODE_RussianMode},
4493 {S_GreekMode ,CANNA_MODE_GreekMode},
4494 {S_LineMode ,CANNA_MODE_LineMode},
4495 {S_ChangingServerMode ,CANNA_MODE_ChangingServerMode},
4496 {S_HenkanMethodMode ,CANNA_MODE_HenkanMethodMode},
4497 {S_DeleteDicMode ,CANNA_MODE_DeleteDicMode},
4498 {S_TourokuMode ,CANNA_MODE_TourokuMode},
4499 {S_TourokuHinshiMode ,CANNA_MODE_TourokuHinshiMode},
4500 {S_TourokuDicMode ,CANNA_MODE_TourokuDicMode},
4501 {S_QuotedInsertMode ,CANNA_MODE_QuotedInsertMode},
4502 {S_BubunMuhenkanMode ,CANNA_MODE_BubunMuhenkanMode},
4503 {S_MountDicMode ,CANNA_MODE_MountDicMode},
4504 {S_ZenHiraHenkanMode ,CANNA_MODE_ZenHiraHenkanMode},
4505 {S_HanHiraHenkanMode ,CANNA_MODE_HanHiraHenkanMode},
4506 {S_ZenKataHenkanMode ,CANNA_MODE_ZenKataHenkanMode},
4507 {S_HanKataHenkanMode ,CANNA_MODE_HanKataHenkanMode},
4508 {S_ZenAlphaHenkanMode ,CANNA_MODE_ZenAlphaHenkanMode},
4509 {S_HanAlphaHenkanMode ,CANNA_MODE_HanAlphaHenkanMode},
4510 {S_ZenHiraKakuteiMode ,CANNA_MODE_ZenHiraKakuteiMode},
4511 {S_HanHiraKakuteiMode ,CANNA_MODE_HanHiraKakuteiMode},
4512 {S_ZenKataKakuteiMode ,CANNA_MODE_ZenKataKakuteiMode},
4513 {S_HanKataKakuteiMode ,CANNA_MODE_HanKataKakuteiMode},
4514 {S_ZenAlphaKakuteiMode ,CANNA_MODE_ZenAlphaKakuteiMode},
4515 {S_HanAlphaKakuteiMode ,CANNA_MODE_HanAlphaKakuteiMode},
4516 {0 ,0},
4517 };
4518
4519 static void
defcannamode()4520 defcannamode()
4521 {
4522 struct cannamodedefs *p;
4523
4524 for (p = cannamodes ; p->mdname ; p++) {
4525 symbolpointer(getatmz(p->mdname))->mid = p->mdid;
4526 }
4527 }
4528
4529
4530
4531 /* ��ǽɽ */
4532
4533 static struct cannafndefs cannafns[] = {
4534 {S_FN_Undefined ,CANNA_FN_Undefined},
4535 {S_FN_SelfInsert ,CANNA_FN_FunctionalInsert},
4536 {S_FN_QuotedInsert ,CANNA_FN_QuotedInsert},
4537 {S_FN_JapaneseMode ,CANNA_FN_JapaneseMode},
4538 {S_AlphaMode ,CANNA_FN_AlphaMode},
4539 {S_HenkanNyuuryokuMode ,CANNA_FN_HenkanNyuryokuMode},
4540 {S_HexMode ,CANNA_FN_HexMode},
4541 {S_BushuMode ,CANNA_FN_BushuMode},
4542 {S_KigouMode ,CANNA_FN_KigouMode},
4543 {S_FN_Forward ,CANNA_FN_Forward},
4544 {S_FN_Backward ,CANNA_FN_Backward},
4545 {S_FN_Next ,CANNA_FN_Next},
4546 {S_FN_Prev ,CANNA_FN_Prev},
4547 {S_FN_BeginningOfLine ,CANNA_FN_BeginningOfLine},
4548 {S_FN_EndOfLine ,CANNA_FN_EndOfLine},
4549 {S_FN_DeleteNext ,CANNA_FN_DeleteNext},
4550 {S_FN_DeletePrevious ,CANNA_FN_DeletePrevious},
4551 {S_FN_KillToEndOfLine ,CANNA_FN_KillToEndOfLine},
4552 {S_FN_Henkan ,CANNA_FN_Henkan},
4553 {S_FN_HenkanNaive ,CANNA_FN_HenkanOrInsert}, /* for compati */
4554 {S_FN_HenkanOrSelfInsert ,CANNA_FN_HenkanOrInsert},
4555 {S_FN_HenkanOrDoNothing ,CANNA_FN_HenkanOrNothing},
4556 {S_FN_Kakutei ,CANNA_FN_Kakutei},
4557 {S_FN_Extend ,CANNA_FN_Extend},
4558 {S_FN_Shrink ,CANNA_FN_Shrink},
4559 {S_ShinshukuMode ,CANNA_FN_AdjustBunsetsu},
4560 {S_FN_Quit ,CANNA_FN_Quit},
4561 {S_ExtendMode ,CANNA_FN_ExtendMode},
4562 {S_FN_Touroku ,CANNA_FN_Touroku},
4563 {S_FN_ConvertAsHex ,CANNA_FN_ConvertAsHex},
4564 {S_FN_ConvertAsBushu ,CANNA_FN_ConvertAsBushu},
4565 {S_FN_KouhoIchiran ,CANNA_FN_KouhoIchiran},
4566 {S_FN_BubunMuhenkan ,CANNA_FN_BubunMuhenkan},
4567 {S_FN_Zenkaku ,CANNA_FN_Zenkaku},
4568 {S_FN_Hankaku ,CANNA_FN_Hankaku},
4569 {S_FN_ToUpper ,CANNA_FN_ToUpper},
4570 {S_FN_Capitalize ,CANNA_FN_Capitalize},
4571 {S_FN_ToLower ,CANNA_FN_ToLower},
4572 {S_FN_Hiragana ,CANNA_FN_Hiragana},
4573 {S_FN_Katakana ,CANNA_FN_Katakana},
4574 {S_FN_Romaji ,CANNA_FN_Romaji},
4575 {S_FN_KanaRotate ,CANNA_FN_KanaRotate},
4576 {S_FN_RomajiRotate ,CANNA_FN_RomajiRotate},
4577 {S_FN_CaseRotate ,CANNA_FN_CaseRotate},
4578 {S_FN_BaseHiragana ,CANNA_FN_BaseHiragana},
4579 {S_FN_BaseKatakana ,CANNA_FN_BaseKatakana},
4580 {S_FN_BaseKana ,CANNA_FN_BaseKana},
4581 {S_FN_BaseEisu ,CANNA_FN_BaseEisu},
4582 {S_FN_BaseZenkaku ,CANNA_FN_BaseZenkaku},
4583 {S_FN_BaseHankaku ,CANNA_FN_BaseHankaku},
4584 {S_FN_BaseKakutei ,CANNA_FN_BaseKakutei},
4585 {S_FN_BaseHenkan ,CANNA_FN_BaseHenkan},
4586 {S_FN_BaseHiraKataToggle ,CANNA_FN_BaseHiraKataToggle},
4587 {S_FN_BaseZenHanToggle ,CANNA_FN_BaseZenHanToggle},
4588 {S_FN_BaseKanaEisuToggle ,CANNA_FN_BaseKanaEisuToggle},
4589 {S_FN_BaseKakuteiHenkanToggle ,CANNA_FN_BaseKakuteiHenkanToggle},
4590 {S_FN_BaseRotateForward ,CANNA_FN_BaseRotateForward},
4591 {S_FN_BaseRotateBackward ,CANNA_FN_BaseRotateBackward},
4592 {S_FN_Mark ,CANNA_FN_Mark},
4593 {S_FN_Temporary ,CANNA_FN_TemporalMode},
4594 {S_FN_SyncDic ,CANNA_FN_SyncDic},
4595 {S_RussianMode ,CANNA_FN_RussianMode},
4596 {S_GreekMode ,CANNA_FN_GreekMode},
4597 {S_LineMode ,CANNA_FN_LineMode},
4598 {S_FN_DefineDicMode ,CANNA_FN_DefineDicMode},
4599 {S_FN_DeleteDicMode ,CANNA_FN_DeleteDicMode},
4600 {S_FN_DicMountMode ,CANNA_FN_DicMountMode},
4601 {S_FN_EnterChikujiMode ,CANNA_FN_EnterChikujiMode},
4602 {S_FN_EnterRenbunMode ,CANNA_FN_EnterRenbunMode},
4603 {S_FN_DisconnectServer ,CANNA_FN_DisconnectServer},
4604 {S_FN_ChangeServerMode ,CANNA_FN_ChangeServerMode},
4605 {S_FN_ShowServer ,CANNA_FN_ShowServer},
4606 {S_FN_ShowGakushu ,CANNA_FN_ShowGakushu},
4607 {S_FN_ShowVersion ,CANNA_FN_ShowVersion},
4608 {S_FN_ShowPhonogramFile ,CANNA_FN_ShowPhonogramFile},
4609 {S_FN_ShowCannaFile ,CANNA_FN_ShowCannaFile},
4610 {S_FN_PageUp ,CANNA_FN_PageUp},
4611 {S_FN_PageDown ,CANNA_FN_PageDown},
4612 {S_FN_Edit ,CANNA_FN_Edit},
4613 {S_FN_BubunKakutei ,CANNA_FN_BubunKakutei},
4614 {S_FN_HenkanRegion ,CANNA_FN_HenkanRegion},
4615 {S_FN_PhonoEdit ,CANNA_FN_PhonoEdit},
4616 {S_FN_DicEdit ,CANNA_FN_DicEdit},
4617 {S_FN_Configure ,CANNA_FN_Configure},
4618 {S_FN_KanaRotate ,CANNA_FN_KanaRotate},
4619 {S_FN_RomajiRotate ,CANNA_FN_RomajiRotate},
4620 {S_FN_CaseRotate ,CANNA_FN_CaseRotate},
4621 {0 ,0},
4622 };
4623
4624 static void
defcannafunc()4625 defcannafunc()
4626 {
4627 struct cannafndefs *p;
4628
4629 for (p = cannafns ; p->fnname ; p++) {
4630 symbolpointer(getatmz(p->fnname))->fid = p->fnid;
4631 }
4632 }
4633
4634
4635 static void
defatms()4636 defatms()
4637 {
4638 deflispfunc();
4639 defcannavar();
4640 defcannamode();
4641 defcannafunc();
4642 QUOTE = getatmz("quote");
4643 T = getatmz("t");
4644 _LAMBDA = getatmz("lambda");
4645 _MACRO = getatmz("macro");
4646 COND = getatmz("cond");
4647 USER = getatmz(":user");
4648 BUSHU = getatmz(":bushu");
4649 RENGO = getatmz(":rengo");
4650 KATAKANA = getatmz(":katakana");
4651 HIRAGANA = getatmz(":hiragana");
4652 GRAMMAR = getatmz(":grammar");
4653 HYPHEN = getatmz("-");
4654 symbolpointer(T)->value = T;
4655 }
4656
4657 #ifndef wchar_t
4658 # error "wchar_t is already undefined"
4659 #endif
4660 #undef wchar_t
4661 /*********************************************************************
4662 * wchar_t replace end *
4663 *********************************************************************/
4664 /* vim: set sw=2: */
4665