home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / LANGUAGS / XLISP / XLISP11.ARK / XLKMAP.C < prev    next >
Text File  |  1986-10-12  |  7KB  |  273 lines
  1. /* xlkmap - xlisp key map functions */
  2.  
  3. #ifdef AZTEC
  4. #include "a:stdio.h"
  5. #else
  6. #include <stdio.h>
  7. #endif
  8.  
  9. #include "xlisp.h"
  10.  
  11. /* external variables */
  12. extern struct node *xlstack;
  13. extern struct node *xlenv;
  14. extern struct node *self;
  15.  
  16. /* local definitions */
  17. #define KMSIZE    256    /* number of characters in a keymap */
  18. #define KMAX    20    /* maximum number of characters in a key sequence */
  19. #define KEYMAP    0    /* instance variable number for 'keymap' */
  20.  
  21. /* local variables */
  22. static struct node *currentenv;
  23.  
  24. /* forward declarations (the extern hack is because of decusc) */
  25. extern struct node *sendmsg();
  26.  
  27. /* isnew - initialize a new keymap */
  28. static struct node *isnew(args)
  29.   struct node *args;
  30. {
  31.     /* make sure there aren't any arguments */
  32.     xllastarg(args);
  33.  
  34.     /* create a keymap node */
  35.     xlivar(self->n_symvalue,KEYMAP)->n_listvalue = newnode(KMAP);
  36.  
  37.     /* return the keymap object */
  38.     return (self->n_symvalue);
  39. }
  40.  
  41. /* newkmap - allocate memory for a new key map vector */
  42. static struct node *(*newkmap())[]
  43. {
  44.     struct node *(*map)[];
  45.  
  46.     /* allocate the vector */
  47.     if ((map = (struct node *(*)[]) calloc(1,sizeof(struct node *) * KMSIZE))
  48.                  == NULL) {
  49.     printf("insufficient memory");
  50.     exit();
  51.     }
  52.  
  53.     /* return the new vector */
  54.     return (map);
  55. }
  56.  
  57. /* key - define a key */
  58. static struct node *key(args)
  59.   struct node *args;
  60. {
  61.     struct node *oldstk,arg,kstr,ksym,*kmap,*kmptr;
  62.     struct node *(*map)[];
  63.     char *sptr;
  64.     int ch;
  65.  
  66.     /* create a new stack frame */
  67.     oldstk = xlsave(&arg,&kstr,&ksym,NULL);
  68.  
  69.     /* initialize */
  70.     arg.n_ptr = args;
  71.  
  72.     /* get the keymap */
  73.     kmap = xlivar(self->n_symvalue,KEYMAP)->n_listvalue;
  74.     if (kmap == NULL && kmap->n_type != KMAP)
  75.     xlfail("bad keymap object");
  76.  
  77.     /* get the key string */
  78.     kstr.n_ptr = xlevmatch(STR,&arg.n_ptr);
  79.  
  80.     /* get the key symbol */
  81.     ksym.n_ptr = xlevmatch(SYM,&arg.n_ptr);
  82.  
  83.     /* make sure there aren't any more arguments */
  84.     xllastarg(arg.n_ptr);
  85.  
  86.     /* process each character in the key string */
  87.     for (kmptr = kmap, sptr = kstr.n_ptr->n_str;
  88.          *sptr != 0;
  89.          kmptr = (*map)[ch]) {
  90.  
  91.     /* get a character */
  92.     ch = *sptr++;
  93.  
  94.     /* allocate a key map vector if non currently exists */
  95.     if ((map = kmptr->n_kmap) == NULL)
  96.         map = kmptr->n_kmap = newkmap();
  97.  
  98.     /* check for this being the last character in the string */
  99.     if (*sptr == 0)
  100.         (*map)[ch] = ksym.n_ptr;
  101.     else
  102.         if ((*map)[ch] == NULL || (*map)[ch]->n_type != KMAP) {
  103.         (*map)[ch] = newnode(KMAP);
  104.         (*map)[ch]->n_kmap = newkmap();
  105.         }
  106.     }
  107.  
  108.     /* restore the previous stack frame */
  109.     xlstack = oldstk;
  110.  
  111.     /* return the keymap object */
  112.     return (self->n_symvalue);
  113. }
  114.  
  115. /* process - process input characters using a key map */
  116. static struct node *process(args)
  117.   struct node *args;
  118. {
  119.     struct node *oldstk,arg,env,margs,*kmap,*kmptr,*nptr,*oldenv;
  120.     struct node *(*map)[];
  121.     char keys[KMAX+1];
  122.     int ch,kndx;
  123.  
  124.     /* create a new stack frame */
  125.     oldstk = xlsave(&arg,&env,&margs,NULL);
  126.  
  127.     /* initialize */
  128.     arg.n_ptr = args;
  129.  
  130.     /* get the keymap */
  131.     kmap = xlivar(self->n_symvalue,KEYMAP)->n_listvalue;
  132.     if (kmap == NULL && kmap->n_type != KMAP)
  133.     xlfail("bad keymap object");
  134.  
  135.     /* get the environment */
  136.     env.n_ptr = xlevmatch(LIST,&arg.n_ptr);
  137.  
  138.     /* make sure there aren't any more arguments */
  139.     xllastarg(arg.n_ptr);
  140.  
  141.     /* bind the current environment variable */
  142.     oldenv = xlenv;
  143.     xlbind(currentenv,env.n_ptr);
  144.     xlfixbindings(oldenv);
  145.  
  146.     /* make sure the key map is defined */
  147.     if (kmap->n_kmap == NULL)
  148.     xlfail("empty keymap");
  149.  
  150.     /* create an argument list to send with key messages */
  151.     margs.n_ptr = newnode(LIST);
  152.     margs.n_ptr->n_listvalue = newnode(STR);
  153.     margs.n_ptr->n_listvalue->n_str = keys;
  154.     margs.n_ptr->n_listvalue->n_strtype = STATIC;
  155.  
  156.     /* character processing loop */
  157.     for (kmptr = kmap, kndx = 0; TRUE; ) {
  158.  
  159.     /* flush pending output */
  160.     fflush(stdout);
  161.  
  162.     /* get a character */
  163.     if ((ch = kbin()) < 0)
  164.         break;
  165.  
  166.     /* put it in the key sequence */
  167.     if (kndx < KMAX)
  168.         keys[kndx++] = ch;
  169.     else
  170.         xlfail("key sequence too long");
  171.  
  172.     /* dispatch on character code */
  173.     if ((map = kmptr->n_kmap) == NULL)
  174.         xlfail("bad keymap");
  175.     else if ((nptr = (*map)[ch]) == NULL) {
  176.         kmptr = kmap;
  177.         kndx = 0;
  178.     }
  179.     else if (nptr->n_type == KMAP)
  180.         kmptr = (*map)[ch];
  181.     else if (nptr->n_type == SYM) {
  182.         keys[kndx] = 0;
  183.         if (sendmsg(nptr,currentenv->n_symvalue,margs.n_ptr) == NULL)
  184.         break;
  185.         kmptr = kmap;
  186.         kndx = 0;
  187.     }
  188.     else
  189.         xlfail("bad keymap");
  190.     }
  191.  
  192.     /* unbind */
  193.     xlunbind(oldenv);
  194.  
  195.     /* restore the previous stack frame */
  196.     xlstack = oldstk;
  197.  
  198.     /* return the keymap object */
  199.     return (self->n_symvalue);
  200. }
  201.  
  202. /* sendmsg - send a message given an environment list */
  203. static struct node *sendmsg(msym,env,args)
  204.   struct node *msym,*env,*args;
  205. {
  206.     struct node *eptr,*obj,*msg;
  207.  
  208.     /* look for an object that answers the message */
  209.     for (eptr = env; eptr != NULL; eptr = eptr->n_listnext)
  210.     if ((obj = eptr->n_listvalue) != NULL && obj->n_type == OBJ)
  211.         if ((msg = xlmfind(obj,msym)) != NULL)
  212.         return (xlxsend(obj,msg,args));
  213.  
  214.     /* return the message if no object answered it */
  215.     return (msym);
  216. }
  217.  
  218. /* xlkmmark - mark a keymap */
  219. xlkmmark(km)
  220.   struct node *km;
  221. {
  222.     struct node *(*map)[];
  223.     int i;
  224.  
  225.     /* mark the keymap node */
  226.     km->n_flags |= MARK;
  227.  
  228.     /* check for a null keymap */
  229.     if ((map = km->n_kmap) == NULL)
  230.     return;
  231.  
  232.     /* loop through each keymap entry */
  233.     for (i = 0; i < KMSIZE; i++)
  234.     if (((*map)[i] != NULL) && (*map)[i]->n_type == KMAP)
  235.         xlkmmark((*map)[i]);
  236. }
  237.  
  238. /* xlkmfree - free a keymap */
  239. xlkmfree(km)
  240.   struct node *km;
  241. {
  242.     struct node *(*map)[];
  243.     int i;
  244.  
  245.     /* check for a null keymap */
  246.     if ((map = km->n_kmap) == NULL)
  247.     return;
  248.  
  249.     /* loop through each keymap entry */
  250.     for (i = 0; i < KMSIZE; i++)
  251.     if (((*map)[i] != NULL) && (*map)[i]->n_type == KMAP)
  252.         xlkmfree((*map)[i]);
  253.  
  254.     /* free this keymap */
  255.     free(km->n_kmap);
  256. }
  257.  
  258. /* xlkinit - key map function initialization routine */
  259. xlkinit()
  260. {
  261.     struct node *keymap;
  262.  
  263.     /* define the xlisp variables */
  264.     currentenv = xlenter("currentenv");
  265.  
  266.     /* define the keymap class */
  267.     keymap = xlclass("Keymap",1);
  268.     xladdivar(keymap,"keymap");
  269.     xladdmsg(keymap,"isnew",isnew);
  270.     xladdmsg(keymap,"key",key);
  271.     xladdmsg(keymap,"process",process);
  272. }
  273.