stk/Src/char.c

224 lines
5.6 KiB
C
Raw Normal View History

1996-09-27 06:29:02 -04:00
/*
*
* c h a r . c -- Characters management
*
1999-09-05 07:16:41 -04:00
* Copyright <EFBFBD> 1993-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
1996-09-27 06:29:02 -04:00
*
*
1999-09-05 07:16:41 -04:00
* Permission to use, copy, modify, distribute,and license this
* software and its documentation for any purpose is hereby granted,
* provided that existing copyright notices are retained in all
* copies and that this notice is included verbatim in any
* distributions. No written agreement, license, or royalty fee is
* required for any of the authorized uses.
* This software is provided ``AS IS'' without express or implied
* warranty.
1996-09-27 06:29:02 -04:00
*
*
* Author: Erick Gallesio [eg@kaolin.unice.fr]
* Creation date: ??????
1999-09-05 07:16:41 -04:00
* Last file update: 3-Sep-1999 20:18 (eg)
1996-09-27 06:29:02 -04:00
*/
#include <ctype.h>
#include "stk.h"
struct charelem {
char *name;
1998-04-10 06:59:06 -04:00
unsigned char value;
1996-09-27 06:29:02 -04:00
};
static struct charelem chartable [] = {
1998-09-30 07:11:02 -04:00
{"null", '\000'},
{"bell", '\007'},
{"backspace", '\010'},
{"newline", '\012'},
{"page", '\014'},
{"return", '\015'},
{"escape", '\033'},
{"space", '\040'},
{"delete", '\177'},
1996-09-27 06:29:02 -04:00
/* poeticless names */
1998-09-30 07:11:02 -04:00
{"nul", '\000'},
{"soh", '\001'},
{"stx", '\002'},
{"etx", '\003'},
{"eot", '\004'},
{"enq", '\005'},
{"ack", '\006'},
{"bel", '\007'},
{"bs", '\010'},
{"ht", '\011'}, /*and also */ {"tab", '\011'},
{"nl", '\012'},
{"vt", '\013'},
{"np", '\014'},
{"cr", '\015'},
{"so", '\016'},
{"si", '\017'},
{"dle", '\020'},
{"dc1", '\021'},
{"dc2", '\022'},
{"dc3", '\023'},
{"dc4", '\024'},
{"nak", '\025'},
{"syn", '\026'},
{"etb", '\027'},
{"can", '\030'},
{"em", '\031'},
{"sub", '\032'},
{"esc", '\033'},
{"fs", '\034'},
{"gs", '\035'},
{"rs", '\036'},
{"us", '\037'},
{"sp", '\040'},
{"del", '\177'},
1996-09-27 06:29:02 -04:00
1998-09-30 07:11:02 -04:00
{"", '\000'}
};
1996-09-27 06:29:02 -04:00
static int my_strcmpi(register char *p1, register char *p2)
{
for( ; tolower(*p1) == tolower(*p2); p1++, p2++)
if (!*p1) return 0;
return tolower(*p1) - tolower(*p2);
}
1998-04-10 06:59:06 -04:00
unsigned char STk_string2char(char *s)
1996-09-27 06:29:02 -04:00
/* converts a char name to a char */
{
register struct charelem *p;
if (s[1] == '\000') return s[0];
for (p=chartable; *(p->name); p++) {
if (my_strcmpi(p->name, s) == 0) return p->value;
}
Err("Bad char name", NIL);
return '\0'; /* never reached */
}
1998-09-30 07:11:02 -04:00
unsigned char *STk_char2string(unsigned char c) /* convert a char to it's */
{ /* external representation */
1998-04-10 06:59:06 -04:00
static unsigned char result[2] = " "; /* sets the \0 */
1996-09-27 06:29:02 -04:00
register struct charelem *p;
for (p=chartable; *(p->name); p++)
1998-09-30 07:11:02 -04:00
if (p->value == c) return (unsigned char *) p->name;
1996-09-27 06:29:02 -04:00
/* If we are here it's a "normal" char */
*result = c;
return result;
}
1998-04-10 06:59:06 -04:00
SCM STk_makechar(unsigned char c)
1996-09-27 06:29:02 -04:00
{
SCM z;
#ifndef COMPACT_SMALL_CST
NEWCELL(z,tc_char);
#endif
1998-04-10 06:59:06 -04:00
SET_CHARACTER(z, (int) c);
1996-09-27 06:29:02 -04:00
return z;
}
/**** Section 6.6 ****/
PRIMITIVE STk_charp(SCM obj)
{
return CHARP(obj) ? Truth: Ntruth;
}
static int charcomp(SCM c1, SCM c2)
{
if (NCHARP(c1)) Err("comparing char: bad char", c1);
if (NCHARP(c2)) Err("comparing char: bad char", c2);
return (CHAR(c1) - CHAR(c2));
}
static int charcompi(SCM c1, SCM c2)
{
if (NCHARP(c1)) Err("comparing char: bad char", c1);
if (NCHARP(c2)) Err("comparing char: bad char", c2);
return (tolower(CHAR(c1)) - tolower(CHAR(c2)));
}
PRIMITIVE STk_chareq (SCM c1, SCM c2){return (charcomp(c1,c2)==0) ?Truth: Ntruth;}
PRIMITIVE STk_charless (SCM c1, SCM c2){return (charcomp(c1,c2)<0) ?Truth: Ntruth;}
PRIMITIVE STk_chargt (SCM c1, SCM c2){return (charcomp(c1,c2)>0) ?Truth: Ntruth;}
PRIMITIVE STk_charlesse(SCM c1, SCM c2){return (charcomp(c1,c2)<=0) ?Truth: Ntruth;}
PRIMITIVE STk_chargte (SCM c1, SCM c2){return (charcomp(c1,c2)>=0) ?Truth: Ntruth;}
PRIMITIVE STk_chareqi (SCM c1, SCM c2){return (charcompi(c1,c2)==0)?Truth:Ntruth;}
PRIMITIVE STk_charlessi (SCM c1, SCM c2){return (charcompi(c1,c2)<0) ?Truth:Ntruth;}
PRIMITIVE STk_chargti (SCM c1, SCM c2){return (charcompi(c1,c2)>0) ?Truth:Ntruth;}
PRIMITIVE STk_charlessei(SCM c1, SCM c2){return (charcompi(c1,c2)<=0)?Truth:Ntruth;}
PRIMITIVE STk_chargtei (SCM c1, SCM c2){return (charcompi(c1,c2)>=0)?Truth:Ntruth;}
PRIMITIVE STk_char_alphap(SCM c)
{
if (NCHARP(c)) Err("char-alphabetic?: bad character", c);
return isalpha(CHAR(c))? Truth: Ntruth;
}
PRIMITIVE STk_char_numericp(SCM c)
{
if (NCHARP(c)) Err("char-numeric?: bad character", c);
return isdigit(CHAR(c))? Truth: Ntruth;
}
PRIMITIVE STk_char_whitep(SCM c)
{
if (NCHARP(c)) Err("char-whitespace?: bad character", c);
return isspace(CHAR(c))? Truth: Ntruth;
}
PRIMITIVE STk_char_upperp(SCM c)
{
if (NCHARP(c)) Err("char-upper-case?: bad character", c);
return isupper(CHAR(c))? Truth: Ntruth;
}
PRIMITIVE STk_char_lowerp(SCM c)
{
if (NCHARP(c)) Err("char-lower-case?: bad character", c);
return islower(CHAR(c))? Truth: Ntruth;
}
PRIMITIVE STk_char2integer(SCM c)
{
if (NCHARP(c)) Err("char->integer: bad character", c);
return STk_makeinteger((long) CHAR(c));
}
PRIMITIVE STk_integer2char(SCM i)
{
int c = STk_integer_value(i);
if (c < 0 || c > MAX_CHAR_CODE) Err("integer->char: bad integer", i);
1998-09-30 07:11:02 -04:00
return STk_makechar((unsigned char) c);
1996-09-27 06:29:02 -04:00
}
PRIMITIVE STk_char_upper(SCM c)
{
if (NCHARP(c)) Err("char-upcase: bad character", c);
1998-09-30 07:11:02 -04:00
return STk_makechar((unsigned char) toupper(CHAR(c)));
1996-09-27 06:29:02 -04:00
}
PRIMITIVE STk_char_lower(SCM c)
{
if (NCHARP(c)) Err("char-downcase: bad character", c);
1998-09-30 07:11:02 -04:00
return STk_makechar((unsigned char) tolower(CHAR(c)));
1996-09-27 06:29:02 -04:00
}