Personal tools
You are here: Home Projects LISP XLISP XLISP 0.0 Sources unpacked xlkmap.c
Document Actions

xlkmap.c

by Paul McJones last modified 2011-01-24 09:58

Click here to get the file

Size 5.8 kB - File type text/x-csrc

File contents

/* xlkmap - xlisp key map functions */

#include <stdio.h>
#include "xlisp.h"

/* external variables */
extern struct node *xlstack;
extern struct node *xlenv;

/* external procedures */
extern struct node *xlevarg();
extern struct node *xlevmatch();
extern struct node *xlmfind();
extern struct node *xlxsend();

/* local definitions */
#define KMSIZE	256	/* number of characters in a keymap */
#define KMAX	20	/* maximum number of characters in a key sequence */

/* local variables */
static struct node *currentenv;

/* keymap - create a new keymap */
static struct node *keymap(args)
  struct node *args;
{
    /* make sure there aren't any arguments */
    if (args != NULL)
	xlfail("too many arguments");

    /* create a keymap node */
    return (newnode(KMAP));
}

/* newkmap - allocate memory for a new key map vector */
static struct node *(*newkmap())[]
{
    struct node *(*map)[];

    /* allocate the vector */
    if ((map = calloc(1,sizeof(struct node *) * KMSIZE)) == NULL) {
	printf("insufficient memory");
	exit();
    }

    /* return the new vector */
    return (map);
}

/* key - define a key */
static struct node *key(args)
  struct node *args;
{
    struct node *oldstk,arg,kmap,kstr,ksym,*kmptr;
    struct node *(*map)[];
    char *sptr;
    int ch;

    /* create a new stack frame */
    oldstk = xlsave(&arg,&kmap,&kstr,&ksym,NULL);

    /* initialize */
    arg.n_ptr = args;

    /* get the keymap pointer */
    kmap.n_ptr = xlevmatch(KMAP,&arg.n_ptr);

    /* get the key string */
    kstr.n_ptr = xlevmatch(STR,&arg.n_ptr);

    /* get the key symbol */
    ksym.n_ptr = xlevmatch(SYM,&arg.n_ptr);

    /* make sure there aren't any more arguments */
    if (arg.n_ptr != NULL)
	xlfail("too many arguments");

    /* process each character in the key string */
    for (kmptr = kmap.n_ptr, sptr = kstr.n_ptr->n_str;
    	 *sptr != 0;
    	 kmptr = (*map)[ch]) {

	/* get a character */
	ch = *sptr++;

	/* allocate a key map vector if non currently exists */
	if ((map = kmptr->n_kmap) == NULL)
	    map = kmptr->n_kmap = newkmap();

	/* check for this being the last character in the string */
	if (*sptr == 0)
	    (*map)[ch] = ksym.n_ptr;
	else
	    if ((*map)[ch] == NULL || (*map)[ch]->n_type != KMAP) {
		(*map)[ch] = newnode(KMAP);
		(*map)[ch]->n_kmap = newkmap();
	    }
    }

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the key map */
    return (kmap.n_ptr);
}

/* kmprocess - process input characters using a key map */
static struct node *kmprocess(args)
  struct node *args;
{
    struct node *oldstk,arg,kmap,env,margs,*kmptr,*nptr,*oldenv;
    struct node *(*map)[];
    char keys[KMAX+1];
    int ch,kndx;

    /* create a new stack frame */
    oldstk = xlsave(&arg,&kmap,&env,&margs,NULL);

    /* initialize */
    arg.n_ptr = args;

    /* get the key map */
    kmap.n_ptr = xlevmatch(KMAP,&arg.n_ptr);

    /* get the environment */
    env.n_ptr = xlevmatch(LIST,&arg.n_ptr);

    /* make sure there aren't any more arguments */
    if (arg.n_ptr != NULL)
	xlfail("too many arguments");

    /* bind the current environment variable */
    oldenv = xlenv;
    xlbind(currentenv,env.n_ptr);
    xlfixbindings(oldenv);

    /* make sure the key map is defined */
    if (kmap.n_ptr->n_kmap == NULL)
	xlfail("empty keymap");

    /* create an argument list to send with key messages */
    margs.n_ptr = newnode(LIST);
    margs.n_ptr->n_listvalue = newnode(STR);
    margs.n_ptr->n_listvalue->n_str = keys;
    margs.n_ptr->n_listvalue->n_strtype = STATIC;

    /* character processing loop */
    for (kmptr = kmap.n_ptr, kndx = 0; TRUE; ) {

	/* flush pending output */
	fflush(stdout);

	/* get a character */
	if ((ch = kbin()) < 0)
	    break;

	/* put it in the key sequence */
	if (kndx < KMAX)
	    keys[kndx++] = ch;
	else
	    xlfail("key sequence too long");

	/* dispatch on character code */
	if ((map = kmptr->n_kmap) == NULL)
	    xlfail("bad keymap");
	else if ((nptr = (*map)[ch]) == NULL) {
	    kmptr = kmap.n_ptr;
	    kndx = 0;
	}
	else if (nptr->n_type == KMAP)
	    kmptr = (*map)[ch];
	else if (nptr->n_type == SYM) {
	    keys[kndx] = 0;
	    sendmsg(nptr,currentenv->n_symvalue,margs.n_ptr);
	    kmptr = kmap.n_ptr;
	    kndx = 0;
	}
	else
	    xlfail("bad keymap");
    }

    /* unbind */
    xlunbind(oldenv);

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the keymap */
    return (kmap.n_ptr);
}

/* sendmsg - send a message given an environment list */
static sendmsg(msym,env,args)
  struct node *msym,*env,*args;
{
    struct node *eptr,*obj,*msg;

    /* look for an object that answers the message */
    for (eptr = env; eptr != NULL; eptr = eptr->n_listnext)
	if ((obj = eptr->n_listvalue) != NULL && obj->n_type == OBJ)
	    if ((msg = xlmfind(obj,msym)) != NULL) {
		xlxsend(obj,msg,args);
		break;
	    }
}

/* xlkmmark - mark a keymap */
xlkmmark(km)
  struct node *km;
{
    struct node *(*map)[];
    int i;

    /* mark the keymap node */
    km->n_flags |= MARK;

    /* check for a null keymap */
    if ((map = km->n_kmap) == NULL)
	return;

    /* loop through each keymap entry */
    for (i = 0; i < KMSIZE; i++)
	if (((*map)[i] != NULL) && (*map)[i]->n_type == KMAP)
	    xlkmmark((*map)[i]);
}

/* xlkmfree - free a keymap */
xlkmfree(km)
  struct node *km;
{
    struct node *(*map)[];
    int i;

    /* check for a null keymap */
    if ((map = km->n_kmap) == NULL)
	return;

    /* loop through each keymap entry */
    for (i = 0; i < KMSIZE; i++)
	if (((*map)[i] != NULL) && (*map)[i]->n_type == KMAP)
	    xlkmfree((*map)[i]);

    /* free this keymap */
    free(km->n_kmap);
}

/* xlkinit - key map function initialization routine */
xlkinit()
{
    /* define the xlisp variables */
    currentenv = xlenter("currentenv");

    /* define the xlisp functions */
    xlsubr("keymap",keymap);
    xlsubr("key",key);
    xlsubr("kmprocess",kmprocess);
}
« December 2014 »
Su Mo Tu We Th Fr Sa
1 2 3 4 5 6
7 8 9 10 11 12 13
14 15 16 17 18 19 20
21 22 23 24 25 26 27
28 29 30 31
 

Powered by Plone CMS, the Open Source Content Management System

This site conforms to the following standards: