uemacs/eval.c

1454 lines
33 KiB
C

/* eval.c -- implements eval.h */
#include "eval.h"
/* Expression evaluation functions
*
* written 1986 by Daniel Lawrence
* modified by Petri Kutvonen
*/
#include <assert.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include "basic.h"
#include "bind.h"
#include "buffer.h"
#include "defines.h"
#include "display.h"
#include "exec.h"
#include "execute.h"
#include "flook.h"
#include "input.h"
#include "line.h"
#include "random.h"
#include "search.h"
#include "terminal.h"
#include "termio.h"
#include "util.h"
#include "version.h"
#include "window.h"
/* Macro argument token types */
#define TKNUL 0 /* end-of-string */
#define TKARG 1 /* interactive argument */
#define TKBUF 2 /* buffer argument */
#define TKVAR 3 /* user variables */
#define TKENV 4 /* environment variables */
#define TKFUN 5 /* function.... */
#define TKDIR 6 /* directive */
#define TKLBL 7 /* line label */
#define TKLIT 8 /* numeric literal */
#define TKSTR 9 /* quoted string literal */
#define TKCMD 10 /* command name */
/* Emacs global flag bit definitions (for gflags). */
/* if GFREAD is set, current buffer will be set on first file (read in) */
#define GFREAD 1
static int gflags = GFREAD ; /* global control flag */
int readfirst_f( void) {
return GFREAD == (gflags & GFREAD) ;
}
int macbug = FALSE ; /* macro debuging flag */
int cmdstatus = TRUE ; /* last command status */
static int flickcode = FALSE ; /* do flicker supression? */
int rval = 0 ; /* return value of a subprocess */
static int saveflag = 0 ; /* Flags, saved with the $target var */
unsigned envram = 0 ; /* # of bytes current in use by malloc */
/* User variables ******************************************/
#define MAXVARS 255
#define NVSIZE 10 /* Max #chars in a var name. */
/* Structure to hold user variables and their definitions. */
static struct {
char u_name[ NVSIZE + 1] ; /* name of user variable */
char *u_value ; /* value (string) */
} uv[ MAXVARS + 1] ;
static char errorm[] = "ERROR" ; /* error literal */
static int seed = 0 ; /* random number seed */
static char *ltos( int val) ;
static char *mkupper( char *dst, char *src) ;
/* List of recognized environment variables. */
static const char *envars[] = {
"fillcol", /* current fill column */
"pagelen", /* number of lines used by editor */
"curcol", /* current column pos of cursor */
"curline", /* current line in file */
"ram", /* ram in use by malloc */
"flicker", /* flicker supression */
"curwidth", /* current screen width */
"cbufname", /* current buffer name */
"cfname", /* current file name */
"sres", /* current screen resolution */
"debug", /* macro debugging */
"status", /* returns the status of the last command */
"palette", /* current palette string */
"asave", /* # of chars between auto-saves */
"acount", /* # of chars until next auto-save */
"lastkey", /* last keyboard char struck */
"curchar", /* current character under the cursor */
"discmd", /* display commands on command line */
"version", /* current version number */
"progname", /* returns current prog name - "MicroEMACS" */
"seed", /* current random number seed */
"disinp", /* display command line input characters */
"wline", /* # of lines in current window */
"cwline", /* current screen line in window */
"target", /* target for line moves */
"search", /* search pattern */
"replace", /* replacement pattern */
"match", /* last matched magic pattern */
"kill", /* kill buffer (read only) */
"cmode", /* mode of current buffer */
"gmode", /* global modes */
"tpause", /* length to pause for paren matching */
"pending", /* type ahead pending flag */
"lwidth", /* width of current line */
"line", /* text of current line */
"gflags", /* global internal emacs flags */
"rval", /* child process return value */
"tab", /* tab width, 1... */
"hardtab", /* TRUE for hard coded tab, FALSE for soft ones */
"viewtab", /* TRUE to visualize hard coded tabs */
"overlap",
"jump",
#if SCROLLCODE
"scroll", /* scroll enabled */
#endif
};
/* And its preprocessor definitions. */
#define EVFILLCOL 0
#define EVPAGELEN 1
#define EVCURCOL 2
#define EVCURLINE 3
#define EVRAM 4
#define EVFLICKER 5
#define EVCURWIDTH 6
#define EVCBUFNAME 7
#define EVCFNAME 8
#define EVSRES 9
#define EVDEBUG 10
#define EVSTATUS 11
#define EVPALETTE 12
#define EVASAVE 13
#define EVACOUNT 14
#define EVLASTKEY 15
#define EVCURCHAR 16
#define EVDISCMD 17
#define EVVERSION 18
#define EVPROGNAME 19
#define EVSEED 20
#define EVDISINP 21
#define EVWLINE 22
#define EVCWLINE 23
#define EVTARGET 24
#define EVSEARCH 25
#define EVREPLACE 26
#define EVMATCH 27
#define EVKILL 28
#define EVCMODE 29
#define EVGMODE 30
#define EVTPAUSE 31
#define EVPENDING 32
#define EVLWIDTH 33
#define EVLINE 34
#define EVGFLAGS 35
#define EVRVAL 36
#define EVTAB 37
#define EVHARDTAB 38
#define EVVIEWTAB 39
#define EVOVERLAP 40
#define EVSCROLLCOUNT 41
#define EVSCROLL 42
enum function_type {
NILNAMIC = 0,
MONAMIC = (1 << 6),
DYNAMIC = (2 << 6),
TRINAMIC = (3 << 6)
} ;
#define ARGCOUNT( ft) (ft >> 6)
#define FUNID( ft) (ft & ((1 << 6) - 1))
enum function_code {
UFADD = 0, UFSUB, UFTIMES, UFDIV, UFMOD, UFNEG,
UFCAT, UFLEFT, UFRIGHT, UFMID, UFNOT, UFEQUAL,
UFLESS, UFGREATER, UFSEQUAL, UFSLESS, UFSGREAT, UFIND,
UFAND, UFOR, UFLENGTH, UFUPPER, UFLOWER, UFTRUTH,
UFASCII, UFCHR, UFGTKEY, UFRND, UFABS, UFSINDEX,
UFENV, UFBIND, UFEXIST, UFFIND, UFBAND, UFBOR,
UFBXOR, UFBNOT, UFXLATE
} ;
/* List of recognized user functions. */
static struct {
const char f_name[ 4] ;
const int f_type ;
} const funcs[] = {
{ "abs", UFABS | MONAMIC }, /* absolute value of a number */
{ "add", UFADD | DYNAMIC }, /* add two numbers together */
{ "and", UFAND | DYNAMIC }, /* logical and */
{ "asc", UFASCII | MONAMIC }, /* char to integer conversion */
{ "ban", UFBAND | DYNAMIC }, /* bitwise and 9-10-87 jwm */
{ "bin", UFBIND | MONAMIC }, /* look up function name bound to key */
{ "bno", UFBNOT | MONAMIC }, /* bitwise not */
{ "bor", UFBOR | DYNAMIC }, /* bitwise or 9-10-87 jwm */
{ "bxo", UFBXOR | DYNAMIC }, /* bitwise xor 9-10-87 jwm */
{ "cat", UFCAT | DYNAMIC }, /* concatenate string */
{ "chr", UFCHR | MONAMIC }, /* integer to char conversion */
{ "div", UFDIV | DYNAMIC }, /* division */
{ "env", UFENV | MONAMIC }, /* retrieve a system environment var */
{ "equ", UFEQUAL | DYNAMIC }, /* logical equality check */
{ "exi", UFEXIST | MONAMIC }, /* check if a file exists */
{ "fin", UFFIND | MONAMIC }, /* look for a file on the path... */
{ "gre", UFGREATER | DYNAMIC }, /* logical greater than */
{ "gtk", UFGTKEY | NILNAMIC }, /* get 1 charater */
{ "ind", UFIND | MONAMIC }, /* evaluate indirect value */
{ "lef", UFLEFT | DYNAMIC }, /* left string(string, len) */
{ "len", UFLENGTH | MONAMIC }, /* string length */
{ "les", UFLESS | DYNAMIC }, /* logical less than */
{ "low", UFLOWER | MONAMIC }, /* lower case string */
{ "mid", UFMID | TRINAMIC }, /* mid string(string, pos, len) */
{ "mod", UFMOD | DYNAMIC }, /* mod */
{ "neg", UFNEG | MONAMIC }, /* negate */
{ "not", UFNOT | MONAMIC }, /* logical not */
{ "or", UFOR | DYNAMIC }, /* logical or */
{ "rig", UFRIGHT | DYNAMIC }, /* right string(string, pos) */
{ "rnd", UFRND | MONAMIC }, /* get a random number */
{ "seq", UFSEQUAL | DYNAMIC }, /* string logical equality check */
{ "sgr", UFSGREAT | DYNAMIC }, /* string logical greater than */
{ "sin", UFSINDEX | DYNAMIC }, /* find the index of one string in another */
{ "sle", UFSLESS | DYNAMIC }, /* string logical less than */
{ "sub", UFSUB | DYNAMIC }, /* substraction */
{ "tim", UFTIMES | DYNAMIC }, /* multiplication */
{ "tru", UFTRUTH | MONAMIC }, /* Truth of the universe logical test */
{ "upp", UFUPPER | MONAMIC }, /* uppercase string */
{ "xla", UFXLATE | TRINAMIC }, /* XLATE character string translation */
} ;
/* When emacs' command interpetor needs to get a variable's name,
* rather than it's value, it is passed back as a variable description
* structure. The v_num field is a index into the appropriate variable table.
*/
typedef struct {
int v_type ; /* Type of variable. */
int v_num ; /* Ordinal pointer to variable in list. */
} variable_description ;
static void findvar( char *var, variable_description *vd, int size) ;
static int svar( variable_description *var, char *value) ;
static const char *i_to_a( int i) ;
/*
* putctext:
* replace the current line with the passed in text
*
* char *iline; contents of new line
*/
static int putctext( char *iline)
{
int status;
/* delete the current line */
curwp->w_doto = 0; /* starting at the beginning of the line */
if ((status = killtext(TRUE, 1)) != TRUE)
return status;
/* insert the new line */
if ((status = linstr(iline)) != TRUE)
return status;
status = lnewline();
backline(TRUE, 1);
return status;
}
static char *result ; /* string result */
static int ressize = 0 ; /* mark result as uninitialized */
static int ernd( int i) ;
static int sindex( char *source, char *pattern) ;
static char *xlat( char *source, char *lookup, char *trans) ;
/* Initialize the user variable list. */
void varinit(void)
{
int i;
for (i = 0; i < MAXVARS; i++)
uv[i].u_name[0] = 0;
if( ressize == 0) {
result = malloc( NSTRING) ;
ressize = NSTRING ;
}
seed = time( NULL) ;
}
/* Evaluate a function.
*
* @fname: name of function to evaluate.
*/
static const char *gtfun( char *fname) {
char *argv[ 3] ;
const char *retstr ; /* return value */
int i ;
/* look the function up in the function table */
fname[ 3] = 0 ; /* only first 3 chars significant */
mklower( fname) ; /* and let it be upper or lower case */
unsigned fnum = ARRAY_SIZE( funcs) ; /* index to function to eval */
int low = 0 ; /* binary search low bound */
int high = fnum - 1 ; /* binary search high bound */
do {
int s, cur ;
cur = (high + low) / 2 ;
s = strcmp( fname, funcs[ cur].f_name) ;
if( s == 0) {
fnum = cur ;
break ;
} else if( s < 0)
high = cur - 1 ;
else
low = cur + 1 ;
} while( low <= high) ;
/* return errorm on a bad reference */
if( fnum == ARRAY_SIZE( funcs))
return errorm ;
/* fetch arguments */
assert( clexec == TRUE) ; /* means macarg can be replaced by gettokval */
int argc = ARGCOUNT( funcs[ fnum].f_type) ;
for( int i = 0 ; i < argc ; i++) {
argv[ i] = getnewtokval() ;
if( argv[ i] == NULL) {
while( i > 0)
free( argv[ --i]) ;
return errorm ;
}
}
/* and now evaluate it! */
switch( FUNID( funcs[ fnum].f_type)) {
int sz, sz1 ;
unicode_t c ;
case UFADD:
retstr = i_to_a( atoi( argv[ 0]) + atoi( argv[ 1])) ;
break ;
case UFSUB:
retstr = i_to_a( atoi( argv[ 0]) - atoi( argv[ 1])) ;
break ;
case UFTIMES:
retstr = i_to_a( atoi( argv[ 0]) * atoi( argv[ 1])) ;
break ;
case UFDIV:
sz = atoi( argv[ 1]) ;
retstr = (sz == 0) ? errorm : i_to_a( atoi( argv[ 0]) / sz) ;
break ;
case UFMOD:
sz = atoi( argv[ 1]) ;
retstr = (sz == 0) ? errorm : i_to_a( atoi( argv[ 0]) % sz) ;
break ;
case UFNEG:
retstr = i_to_a( -atoi( argv[ 0])) ;
break ;
case UFCAT:
sz1 = strlen( argv[ 0]) ;
sz = sz1 + strlen( argv[ 1]) + 1 ;
if( sz > ressize) {
free( result) ;
result = malloc( sz) ;
ressize = sz ;
}
strcpy( result, argv[ 0]) ;
strcpy( &result[ sz1], argv[ 1]) ;
retstr = result ;
break ;
case UFLEFT:
sz1 = strlen( argv[ 0]) ;
sz = 0 ;
for( int i = atoi( argv[ 1]) ; sz < sz1 && i > 0 ; i -= 1)
sz += utf8_to_unicode( argv[ 0], sz, sz1, &c) ;
if( sz >= ressize) {
free( result) ;
result = malloc( sz + 1) ;
ressize = sz + 1 ;
}
mystrscpy( result, argv[ 0], sz + 1) ;
retstr = result ;
break ;
case UFRIGHT:
sz = strlen( argv[ 0]) ;
for( sz1 = atoi( argv[ 1]) ; sz1 > 0 && sz > 0 ; sz1--)
if( --sz > 0)
sz -= utf8_revdelta( (unsigned char *) &( argv[ 0])[ sz], sz) ;
retstr = &( argv[ 0])[ sz] ;
sz = strlen( retstr) ;
if( sz >= ressize) {
free( result) ;
ressize = sz + 1 ;
result = malloc( ressize) ;
}
retstr = strcpy( result, retstr) ;
break ;
case UFMID:
sz1 = strlen( argv[ 0]) ;
int start = 0 ;
for( i = atoi( argv[ 1]) - 1 ; start < sz1 && i > 0 ; i -= 1)
start += utf8_to_unicode( argv[ 0], start, sz1, &c) ;
sz = start ;
for( i = atoi( argv[ 2]) ; sz < sz1 && i > 0 ; i -= 1)
sz += utf8_to_unicode( argv[ 0], sz, sz1, &c) ;
sz -= start ;
if( sz >= ressize) {
free( result) ;
result = malloc( sz + 1) ;
ressize = sz + 1 ;
}
mystrscpy( result, &(argv[ 0][ start]), sz + 1) ;
retstr = result ;
break ;
case UFNOT:
retstr = ltos( stol( argv[ 0]) == FALSE) ;
break ;
case UFEQUAL:
retstr = ltos( atoi( argv[ 0]) == atoi( argv[ 1])) ;
break ;
case UFLESS:
retstr = ltos( atoi( argv[ 0]) < atoi( argv[ 1])) ;
break ;
case UFGREATER:
retstr = ltos( atoi( argv[ 0]) > atoi( argv[ 1])) ;
break ;
case UFSEQUAL:
retstr = ltos( strcmp( argv[ 0], argv[ 1]) == 0) ;
break ;
case UFSLESS:
retstr = ltos( strcmp( argv[ 0], argv[ 1]) < 0) ;
break ;
case UFSGREAT:
retstr = ltos( strcmp( argv[ 0], argv[ 1]) > 0) ;
break ;
case UFIND:
retstr = getval( argv[ 0]) ;
sz = strlen( retstr) + 1 ;
if( sz > ressize) {
free( result) ;
result = malloc( sz) ;
ressize = sz ;
}
retstr = strcpy( result, retstr) ;
break ;
case UFAND:
retstr = ltos( stol( argv[ 0]) && stol( argv[ 1])) ;
break ;
case UFOR:
retstr = ltos( stol( argv[ 0]) || stol( argv[ 1])) ;
break ;
case UFLENGTH:
retstr = i_to_a( strlen( argv[ 0])) ;
break ;
case UFUPPER:
sz = strlen( argv[ 0]) ;
if( sz >= ressize) {
free( result) ;
result = malloc( sz + 1) ;
ressize = sz + 1 ;
}
retstr = mkupper( result, argv[ 0]) ;
break ;
case UFLOWER:
sz = strlen( argv[ 0]) ;
if( sz >= ressize) {
free( result) ;
result = malloc( sz + 1) ;
ressize = sz + 1 ;
}
strcpy( result, argv[ 0]) ; /* result is at least as long as argv[ 0] */
retstr = mklower( result) ;
break ;
case UFTRUTH:
retstr = ltos( atoi( argv[ 0]) == 42) ;
break ;
case UFASCII:
utf8_to_unicode( argv[ 0], 0, 4, &c) ;
retstr = i_to_a( c) ;
break ;
case UFCHR:
c = atoi( argv[ 0]) ;
if( c > 0x10FFFF)
retstr = errorm ;
else {
sz = unicode_to_utf8( c, result) ;
result[ sz] = 0 ;
retstr = result ;
}
break ;
case UFGTKEY:
result[0] = tgetc();
result[1] = 0;
retstr = result ;
break ;
case UFRND:
retstr = i_to_a( ernd( atoi( argv[ 0]))) ;
break ;
case UFABS:
retstr = i_to_a( abs( atoi( argv[ 0]))) ;
break ;
case UFSINDEX:
retstr = i_to_a( sindex( argv[ 0], argv[ 1])) ;
break ;
case UFENV:
#if ENVFUNC
retstr = getenv( argv[ 0]) ;
if( retstr == NULL)
#endif
retstr = "" ;
break ;
case UFBIND:
retstr = transbind( argv[ 0]) ;
break ;
case UFEXIST:
retstr = ltos( fexist( argv[ 0])) ;
break ;
case UFFIND:
retstr = flook( argv[ 0], TRUE) ;
if( retstr == NULL)
retstr = "" ;
break ;
case UFBAND:
retstr = i_to_a( atoi( argv[ 0]) & atoi( argv[ 1])) ;
break ;
case UFBOR:
retstr = i_to_a( atoi( argv[ 0]) | atoi( argv[ 1])) ;
break ;
case UFBXOR:
retstr = i_to_a( atoi( argv[ 0]) ^ atoi( argv[ 1])) ;
break ;
case UFBNOT:
retstr = i_to_a( ~atoi( argv[ 0])) ;
break ;
case UFXLATE:
retstr = xlat( argv[ 0], argv[ 1], argv[ 2]) ;
break ;
default:
assert( FALSE) ; /* never should get here */
retstr = errorm ;
}
while( argc > 0)
free( argv[ --argc]) ;
return retstr ;
}
/*
* look up a user var's value
*
* char *vname; name of user variable to fetch
*/
static char *gtusr( char *vname) {
int vnum; /* ordinal number of user var */
/* scan the list looking for the user var name */
for (vnum = 0; vnum < MAXVARS; vnum++) {
if (uv[vnum].u_name[0] == 0)
break ;
if( strncmp( vname, uv[ vnum].u_name, NVSIZE) == 0)
return uv[vnum].u_value;
}
/* return errorm if we run off the end */
return errorm;
}
/* getctext: grab and return a string with the text of the current line */
static const char *getctext( void) {
static int rsize = 0 ;
static char *rline = NULL ; /* line to return */
/* find the contents of the current line and its length */
line_p lp = curwp->w_dotp ; /* line to copy */
int size = lp->l_used ; /* length of line to return */
if( size >= rsize) {
/* extend storage */
int newsize = size + 1 ;
char *newstr = realloc( rline, newsize) ;
if( newstr == NULL)
return "" ;
rline = newstr ;
rsize = newsize ;
}
/* copy it across */
memcpy( rline, lp->l_text, size) ;
rline[ size] = 0 ;
return rline ;
}
/* gtenv()
*
* char *vname; name of environment variable to retrieve
*/
static const char *gtenv( char *vname) {
unsigned vnum ; /* ordinal number of var referenced */
/* scan the list, looking for the referenced name */
for( vnum = 0 ; vnum < ARRAY_SIZE( envars) ; vnum++)
if( strcmp( vname, envars[ vnum]) == 0)
break ;
/* return errorm on a bad reference */
if( vnum == ARRAY_SIZE( envars)) {
#if ENVFUNC
char *ename = getenv(vname);
if( ename != NULL)
return ename ;
#endif
return errorm ;
}
/* otherwise, fetch the appropriate value */
switch (vnum) {
case EVFILLCOL:
return i_to_a(fillcol);
case EVPAGELEN:
return i_to_a(term.t_nrow + 1);
case EVCURCOL:
return i_to_a(getccol(FALSE));
case EVCURLINE:
return i_to_a(getcline());
case EVRAM:
return i_to_a((int) (envram / 1024l));
case EVFLICKER:
return ltos(flickcode);
case EVCURWIDTH:
return i_to_a(term.t_ncol);
case EVCBUFNAME:
return curbp->b_bname;
case EVCFNAME:
return curbp->b_fname;
case EVSRES:
return sres;
case EVDEBUG:
return ltos(macbug);
case EVSTATUS:
return ltos(cmdstatus);
case EVPALETTE: {
static char palstr[ 49] = "" ; /* palette string */
return palstr;
}
case EVASAVE:
return i_to_a(gasave);
case EVACOUNT:
return i_to_a(gacount);
case EVLASTKEY:
return i_to_a(lastkey);
case EVCURCHAR: {
unicode_t c ;
lgetchar( &c) ;
return i_to_a( c) ;
}
case EVDISCMD:
return ltos(discmd);
case EVVERSION:
return VERSION;
case EVPROGNAME:
return PROGRAM_NAME_UTF8 ;
case EVSEED:
return i_to_a(seed);
case EVDISINP:
return ltos(disinp);
case EVWLINE:
return i_to_a(curwp->w_ntrows);
case EVCWLINE:
return i_to_a(getwpos());
case EVTARGET:
saveflag = lastflag;
return i_to_a(curgoal);
case EVSEARCH:
return pat;
case EVREPLACE:
return rpat;
case EVMATCH:
return (patmatch == NULL) ? "" : patmatch;
case EVKILL:
return getkill();
case EVCMODE:
return i_to_a(curbp->b_mode);
case EVGMODE:
return i_to_a(gmode);
case EVTPAUSE:
return i_to_a(term.t_pause);
case EVPENDING:
#if TYPEAH
return ltos(typahead());
#else
return falsem;
#endif
case EVLWIDTH:
return i_to_a(llength(curwp->w_dotp));
case EVLINE:
return getctext();
case EVGFLAGS:
return i_to_a(gflags);
case EVRVAL:
return i_to_a(rval);
case EVTAB:
return i_to_a( tabwidth) ;
case EVHARDTAB:
return ltos( hardtab) ;
case EVVIEWTAB:
return ltos( viewtab) ;
case EVOVERLAP:
return i_to_a(overlap);
case EVSCROLLCOUNT:
return i_to_a(scrollcount);
#if SCROLLCODE
case EVSCROLL:
return ltos(term.t_scroll != NULL);
#else
case EVSCROLL:
return ltos(0);
#endif
}
assert( FALSE) ; /* again, we should never get here */
return errorm ;
}
/* set a variable
*
* int f; default flag
* int n; numeric arg (can overide prompted value)
*/
BINDABLE( setvar) {
int status; /* status return */
variable_description vd ; /* variable num/type */
char var[NVSIZE + 2]; /* name of variable to fetch %1234567890\0 */
char *value ; /* value to set variable to */
/* first get the variable to set.. */
if (clexec == FALSE) {
status = getstring( "Variable to set: ", var, sizeof var, nlc) ;
if (status != TRUE)
return status;
} else { /* macro line argument */
/* grab token and skip it */
gettoken( var, sizeof var) ;
}
/* check the legality and find the var */
findvar( var, &vd, sizeof var) ;
/* if its not legal....bitch */
if (vd.v_type == -1) {
mlwrite("%%No such variable as '%s'", var);
return FALSE;
}
/* get the value for that variable */
if( f == TRUE) {
value = malloc( NSTRING) ;
if( value == NULL)
return FALSE ;
/* a bit overcautious here */
mystrscpy( value, i_to_a( n), NSTRING) ;
} else {
status = newmlarg( &value, "Value: ", 0) ;
if (status != TRUE)
return status;
}
/* and set the appropriate value */
status = svar(&vd, value);
#if DEBUGM
/* if $debug == TRUE, every assignment will echo a statment to
that effect here. */
if( macbug)
if( abortc == mdbugout( "(((%s:%s:%s)))", ltos( status), var, value))
status = FALSE ;
#endif
/* and return it */
free( value) ;
return status;
}
static void mlforce( char *s) ;
#if DEBUGM
int mdbugout( char *fmt, ...) {
int c ; /* input from kbd, output to terminal */
int savediscmd ;
va_list ap ;
/* assignment status ; variable name ; value we tried to assign */
/* write out the debug line */
savediscmd = discmd ;
discmd = TRUE ;
va_start( ap, fmt) ;
vmlwrite( fmt, ap) ;
va_end( ap) ;
discmd = savediscmd ;
update( TRUE) ;
/* and get the keystroke to hold the output */
c = get1key() ;
if( c == abortc)
mlforce( "(Macro aborted)") ;
return c ;
}
#endif
/*
* Find a variables type and name.
*
* @var: name of variable to get.
* @vd: structure to hold type and pointer.
* @size: size of variable array.
*/
static void findvar(char *var, variable_description *vd, int size)
{
unsigned vnum = 0 ; /* subscript in variable arrays */
int vtype; /* type to return */
fvar:
vtype = -1;
switch (var[0]) {
case '$': /* check for legal enviromnent var */
for (vnum = 0; vnum < ARRAY_SIZE(envars); vnum++)
if (strcmp(&var[1], envars[vnum]) == 0) {
vtype = TKENV;
break;
}
break;
case '%': /* check for existing legal user variable */
for (vnum = 0; vnum < MAXVARS; vnum++)
if (strcmp(&var[1], uv[vnum].u_name) == 0) {
vtype = TKVAR;
break;
}
if (vnum < MAXVARS)
break;
/* create a new one??? */
for (vnum = 0; vnum < MAXVARS; vnum++)
if (uv[vnum].u_name[0] == 0) {
vtype = TKVAR;
mystrscpy( uv[ vnum].u_name, &var[ 1], NVSIZE + 1) ;
break;
}
break;
case '&': /* indirect operator? */
var[4] = 0;
if (strcmp(&var[1], "ind") == 0) {
/* grab token, and eval it */
if( TRUE == gettokval( var, size))
goto fvar ;
}
}
/* return the results */
vd->v_num = vnum;
vd->v_type = vtype;
return;
}
/*
* Set a variable.
*
* @var: variable to set.
* @value: value to set to.
*/
static int svar( variable_description *var, char *value)
{
int vnum; /* ordinal number of var refrenced */
int vtype; /* type of variable to set */
int status; /* status return */
int c; /* translated character */
char *sp; /* scratch string pointer */
/* simplify the vd structure (we are gonna look at it a lot) */
vnum = var->v_num;
vtype = var->v_type;
/* and set the appropriate value */
status = TRUE;
switch (vtype) {
case TKVAR: /* set a user variable */
if (uv[vnum].u_value != NULL)
free(uv[vnum].u_value);
sp = malloc(strlen(value) + 1);
if (sp == NULL)
return FALSE;
strcpy(sp, value);
uv[vnum].u_value = sp;
break;
case TKENV: /* set an environment variable */
status = TRUE; /* by default */
switch (vnum) {
case EVFILLCOL:
fillcol = atoi(value);
break;
case EVPAGELEN:
status = newsize(TRUE, atoi(value));
break;
case EVCURCOL:
status = setccol(atoi(value));
break;
case EVCURLINE:
status = gotoline(TRUE, atoi(value));
break;
case EVRAM:
break;
case EVFLICKER:
flickcode = stol(value);
break;
case EVCURWIDTH:
status = newwidth(TRUE, atoi(value));
break;
case EVCBUFNAME:
strcpy(curbp->b_bname, value);
curwp->w_flag |= WFMODE;
break;
case EVCFNAME:
strcpy(curbp->b_fname, value);
curwp->w_flag |= WFMODE;
break;
case EVSRES:
status = TTrez(value);
break;
case EVDEBUG:
macbug = stol(value);
break;
case EVSTATUS:
cmdstatus = stol(value);
break;
case EVASAVE:
gasave = atoi(value);
break;
case EVACOUNT:
gacount = atoi(value);
break;
case EVLASTKEY:
lastkey = atoi(value);
break;
case EVCURCHAR:
ldelchar(1, FALSE); /* delete 1 char */
c = atoi(value);
if (c == '\n')
lnewline();
else
linsert(1, c);
backchar(FALSE, 1);
break;
case EVDISCMD:
discmd = stol(value);
break;
case EVVERSION:
break;
case EVPROGNAME:
break;
case EVSEED:
seed = atoi(value);
break;
case EVDISINP:
disinp = stol(value);
break;
case EVWLINE:
status = resize(TRUE, atoi(value));
break;
case EVCWLINE:
status = forwline(TRUE, atoi(value) - getwpos());
break;
case EVTARGET:
curgoal = atoi(value);
thisflag = saveflag;
break;
case EVSEARCH:
strcpy(pat, value);
rvstrcpy(tap, pat);
#if MAGIC
mcclear();
#endif
break;
case EVREPLACE:
strcpy(rpat, value);
break;
case EVMATCH:
break;
case EVKILL:
break;
case EVCMODE:
curbp->b_mode = atoi(value);
curwp->w_flag |= WFMODE;
break;
case EVGMODE:
gmode = atoi(value);
break;
case EVTPAUSE:
term.t_pause = atoi(value);
break;
case EVPENDING:
break;
case EVLWIDTH:
break;
case EVLINE:
return putctext( value) ;
case EVGFLAGS:
gflags = atoi(value);
break;
case EVRVAL:
break;
case EVTAB:
c = atoi( value) ;
if( c > 0) {
tabwidth = c ;
curwp->w_flag |= WFHARD;
} else
status = FALSE ;
break;
case EVHARDTAB:
hardtab = stol( value) ;
break ;
case EVVIEWTAB:
viewtab = stol( value) ;
break ;
case EVOVERLAP:
overlap = atoi(value);
break;
case EVSCROLLCOUNT:
scrollcount = atoi(value);
break;
case EVSCROLL:
#if SCROLLCODE
if (!stol(value))
term.t_scroll = NULL;
#endif
break;
}
break;
}
return status;
}
/*
* i_to_a:
* integer to ascii string.......... This is too
* inconsistant to use the system's
*
* int i; integer to translate to a string
*/
static const char *i_to_a( int i) {
unsigned u ;
int sign ; /* sign of resulting number */
/* returns result string: sign digits null */
static char result[ 1 + (sizeof i * 5 + 1) / 2 + 1] ;
char *sp = &result[ sizeof result - 1] ; /* points on result's last byte */
*sp = 0 ;
/* record the sign... */
sign = i < 0 ;
u = sign ? -i : i ;
/* and build the string (backwards!) */
do {
*(--sp) = '0' + u % 10 ; /* install the new digit */
u = u / 10 ;
} while( u) ;
/* and fix the sign */
if( sign)
*(--sp) = '-'; /* and install the minus sign */
return sp ;
}
/* find the type of a token based on first character
*
* char c ; first character of analyzed token
*/
static int gettyp( char c) {
switch( c) {
case '*':
case ':':
return TKLBL ;
case 0: /* no blanks!!! */
return TKNUL ;
case '"':
return TKSTR ;
case '!':
return TKDIR ;
case '@':
return TKARG ;
case '=':
return TKBUF ;
case '$':
return TKENV ;
case '%':
return TKVAR ;
case '&':
return TKFUN ;
default:
/* a numeric literal? */
if( (c >= '0' && c <= '9') || c == '-')
return TKLIT ;
else
return TKCMD ;
}
}
int is_it_cmd( char *token) {
return TKCMD == gettyp( *token) ;
}
/* find the value of a token
*
* char *token; token to evaluate
*/
const char *getval( char *token) {
static char buf[ NSTRING] ; /* string buffer for some returns */
switch( gettyp( *token)) {
case TKARG: /* interactive argument */
strcpy( token, getval( &token[ 1])) ;
int distmp = discmd ; /* echo it always! */
discmd = TRUE ;
int status = getstring( token, buf, NSTRING, nlc) ;
discmd = distmp ;
if (status == ABORT)
return errorm ;
return buf ;
case TKBUF: /* buffer contents fetch */
/* grab the right buffer */
strcpy( token, getval( &token[ 1])) ;
buffer_p bp = bfind( token, FALSE, 0) ;
if (bp == NULL)
return errorm ;
/* if the buffer is displayed,
get the window vars instead of the buffer vars */
if (bp->b_nwnd > 0) {
curbp->b_dotp = curwp->w_dotp;
curbp->b_doto = curwp->w_doto;
}
/* make sure we are not at the end */
if (bp->b_linep == bp->b_dotp)
return errorm;
/* grab the line as an argument */
unsigned blen = bp->b_dotp->l_used - bp->b_doto;
if( blen >= sizeof buf)
blen = sizeof buf - 1 ;
mystrscpy( buf, bp->b_dotp->l_text + bp->b_doto, blen + 1) ;
/* and step the buffer's line ptr ahead a line */
bp->b_dotp = bp->b_dotp->l_fp;
bp->b_doto = 0;
/* if displayed buffer, reset window ptr vars */
if (bp->b_nwnd > 0) {
curwp->w_dotp = curbp->b_dotp;
curwp->w_doto = 0;
curwp->w_flag |= WFMOVE;
}
/* and return the spoils */
return buf;
case TKVAR:
return gtusr(token + 1);
case TKENV:
return gtenv(token + 1);
case TKFUN:
return gtfun(token + 1);
case TKLIT:
return token;
case TKSTR:
return token + 1;
case TKCMD:
return token;
case TKDIR:
case TKLBL:
case TKNUL:
return "" ;
}
return errorm ;
}
/*
* convert a string to a numeric logical
*
* char *val; value to check for stol
*/
int stol(char *val)
{
/* check for logical values */
if (val[0] == 'F')
return FALSE;
if (val[0] == 'T')
return TRUE;
/* check for numeric truth (!= 0) */
return (atoi(val) != 0);
}
/*
* numeric logical to string logical
*
* int val; value to translate
*/
static char *ltos( int val) {
static char *boolm[] = { "TRUE", "FALSE" } ;
return boolm[ !val] ;
}
/*
* make a string upper case
*
* char *src ; string to upper case
* char *dst ; where to store
* dst must be at least as long as src.
*/
static char *mkupper( char *dst, char *src) {
char c, *sp ;
sp = dst ;
while( (c = *src++)) {
if( 'a' <= c && c <= 'z')
c += 'A' - 'a' ;
*sp++ = c ;
}
*sp = 0 ;
return dst ;
}
/*
* make a string lower case
*
* char *str; string to lower case
*/
char *mklower(char *str)
{
char *sp;
sp = str;
while (*sp) {
if ('A' <= *sp && *sp <= 'Z')
*sp += 'a' - 'A';
++sp;
}
return str;
}
/*
* returns a random integer
* ernd( 0) [ 0 .. 2147483647]
* ernd( -2147483648) [ 0 .. 2147483647]
* ernd( 1) [ 1]
* ernd( i) [ 1 .. abs( i)]
*/
static int ernd( int i) {
int s ;
seed = seed * 1721 + 10007 ;
s = ((seed >> 16) & 0x0000FFFF) | (seed << 16) ;
s &= ~(1 << 31) ; /* avoid abs() */
i = i < 0 ? -i : i ; /* abs( i) */
return (i <= 0) ? s : s % i + 1 ;
}
/* find pattern within source
*
* char *source; source string to search
* char *pattern; string to look for
*/
static int sindex( char *source, char *pattern) {
/* scanning through the source string */
char *sp = source ; /* ptr to current position to scan */
int idx = 1 ;
int pos = 0 ;
int len = strlen( source) ;
while( *sp) {
char c ;
unicode_t uc ;
/* scan through the pattern */
char *cp = pattern ; /* ptr to place to check for equality */
char *csp = sp ; /* ptr to source string during comparison */
while( (c = *cp++) && eq( c, *csp))
csp++ ;
/* was it a match? */
if( c == 0)
return idx ;
idx += 1 ;
pos += utf8_to_unicode( source, pos, len, &uc) ;
sp = &source[ pos] ;
}
/* no match at all.. */
return 0 ;
}
/*
* Filter a string through a translation table
*
* char *source; string to filter
* char *lookup; characters to translate
* char *trans; resulting translated characters
*/
static char *xlat( char *source, char *lookup, char *trans) {
char *sp; /* pointer into source table */
char *lp; /* pointer into lookup table */
char *rp; /* pointer into result */
static char result[NSTRING]; /* temporary result */
/* scan source string */
sp = source;
rp = result;
while (*sp) {
/* scan lookup table for a match */
lp = lookup;
while (*lp) {
if (*sp == *lp) {
*rp++ = trans[lp - lookup];
goto xnext;
}
++lp;
}
/* no match, copy in the source char untranslated */
*rp++ = *sp;
xnext:++sp;
}
/* terminate and return the result */
*rp = 0;
return result;
}
/*
* Force a string out to the message line regardless of the
* current $discmd setting. This is needed when $debug is TRUE
* and for the write-message and clear-message-line commands
*
* char *s; string to force out
*/
static void mlforce( char *s) {
int oldcmd; /* original command display flag */
oldcmd = discmd; /* save the discmd value */
discmd = TRUE; /* and turn display on */
mlwrite( (*s) ? "%s" : "", s) ; /* write the string out or erase line */
discmd = oldcmd; /* and restore the original setting */
}
/* This function simply clears the message line, mainly for macro usage
*
* int f, n; arguments ignored
*/
TBINDABLE( clrmes) {
mlforce( "") ;
return TRUE ;
}
/* This function writes a string on the message line mainly for macro usage
*
* int f, n; arguments ignored
*/
BINDABLE( writemsg) {
char *buf ; /* buffer to receive message into */
int status = newmlarg( &buf, "write-message: ", 0) ;
if( status == TRUE) {
/* write the message out */
mlforce( buf) ;
free( buf) ;
}
return status ;
}
/* end of eval.c */