/* Probabalistic spelling checker for emacs
 *
 * Based on a note in CACM, May 1981 (vol 24, no 5, pp.297,298) by Robert Nix
 *
 * 10 independent random hash functions are computed on the word, and if
 * they all correspond to hash values of a known good word, the word is
 * deemed to be correct.  The hash values are used to index into bitmaps,
 * where a 1 bit indicates that the value is ok.
 *
 * The hash functions are computed using random exor tables, which are
 * saved along with the bitmaps in a file (default name .spelltab on the
 * user's load search path).
 *
 * Frank D. Cringle, 1.2.86
 */

#include <stdio.h>
#include "buffer.h"
#include "config.h"
#include "keyboard.h"
#include "mlisp.h"
#include "window.h"
#ifdef apm
#define gettime(t)	((t) = cputime())
#else
#include <sys/types.h>
#include <sys/times.h>
#define gettime(t)	{struct tms Time;\
			 times(&Time);\
			 (t) = Time.tms_utime;}
#endif

#define CHAR_BITS	 8
#define SHORT_BITS	16
#define LONG_BITS	32
#define N_EXOR		32
#define N_TABLE		8192
#define N_HASH		10
#define EXOR_LONGS	(N_EXOR*SHORT_BITS/LONG_BITS)
#define TABLE_LONGS	(N_TABLE*CHAR_BITS/LONG_BITS)

/* default name of spelling table file */
#define SPELLTAB	".spelltab"

/* the spelltab file is an array of 10 of these structures */
struct HashTab {
	unsigned short Exor[N_EXOR];	/* parameters for hash function */
	unsigned char Table[N_TABLE];	/* bitmap addressed by hash value */
};

static struct HashTab *SpellTab;	/* pointer to hashtables once
					   they have been read in */

static unsigned char BitTable[] = { 128, 64, 32, 16, 8, 4, 2, 1 };

/* Read SpellTab file */
static
GetSpellTab(fn)
register char *fn;		/* filename */
{
    char    stfn[MaxPathNameLen];
    FILE * stf;
    char   *malloc ();

    if (!SpellTab)
	SpellTab = (struct HashTab *) malloc (N_HASH * sizeof *SpellTab);
    if (!SpellTab) {
	error ("Not enough memory for spelling table");
	return 0;
    }
    if ((stf = fopenp (LoadSearchPath, fn, stfn, "r")) == NULL) {
	error ("Can't read %s", fn);
	return 0;
    }
    message ("Loading spelling table...");
    DoDsp (1);
    if ((fread (SpellTab, sizeof (*SpellTab), N_HASH, stf) != N_HASH) ||
	    (getc (stf) != EOF)) {
	error ("wrong file size (%s)", stfn);
	return 0;
    }
    fclose (stf);
    return 1;
}

/* MLisp fuction to read named (or default) spelling table */
static
ReadSpellTab()
{
    register char  *fn = getstr (": read-spelltab ");

    if (!fn)
	return 0;
    if (!*fn)
	fn = SPELLTAB;
    GetSpellTab (fn);
    return 0;
}

/* MLisp function to save the spelling table in a file */
static
WriteSpellTab()
{
    register char  *fn;
    FILE   *stf;
    char    ffn[MaxPathNameLen];

    if (!SpellTab) {
	error ("Spelling table undefined");
	return 0;
    }
    if (!(fn = getstr (": write-spelltab ")))
	return 0;
    if (!*fn)
	fn = SPELLTAB;
    if (abspath (fn, ffn) == -1 || (stf = fopen (ffn, "w")) == NULL) {
	error ("Can't create %s", fn);
	return 0;
    }
    if (fwrite (SpellTab, sizeof (*SpellTab), N_HASH, stf) != N_HASH) {
	error ("Can't write spelling table (%s)", fn);
	return 0;
    }
    fclose (stf);
    return 0;
}

/* MLisp function which creates an empty spelling table */
static
CreateSpellTab()
{
    register    bit,
                i,		/* index over hash tables */
                j,		/* index over long entries per table */
                k;		/* index over bits per long entry */
    register unsigned long  rand,/* LFSR */
                            rand1;/* accumulator for random bit string */
    register struct HashTab *htp;
    register unsigned long *hte;

    if (!SpellTab)
	SpellTab = (struct HashTab *) malloc (N_HASH * sizeof *SpellTab);
    if (!SpellTab) {
	error ("Not enough memory for spelling table");
	return 0;
    }
    gettime (rand);		/* random number seed */
    rand1 = 0;
    for (i = 0, htp = SpellTab; i < N_HASH; i++, htp++) {
	for (j = 0, hte = (unsigned long *) htp -> Exor; j < EXOR_LONGS; j++) {
	    for (k = 0; k < N_EXOR; k++) {
		for (;;) {
		    bit = rand & 1;
		    rand >>= 1;
		    if (bit)
			rand ^= 0x80030001;
		    if (rand)
			break;
		    gettime (rand);
		}
		rand1 = (rand1 << 1) + bit;
	    }
	    *hte++ = rand1;
	}
    /* clear the table down to zeros */
	for (j = 0, hte = (unsigned long *) htp -> Table; j < TABLE_LONGS; j++)
	    *hte++ = 0;
    }
    return 0;
}

/* internal single word spelling check */
static
Lookup(word)
char *word;
{
    register    i;
    register char  *cp;
    register unsigned short H;
    register struct HashTab *htp;

    if (!word || !*word)
	return 0;
    if (!SpellTab && !GetSpellTab (SPELLTAB))
	return 0;
    for (i = 0, htp = SpellTab; i < N_HASH; i++, htp++) {
	for (H = 0, cp = word; *cp;) {
	    H = (H & 0x8000) ? (H << 1) + 1 : (H << 1);
	    H ^= htp -> Exor[*cp++ & (N_EXOR-1)];
	}
	if (!(htp -> Table[(H >> 3) & (N_TABLE-1)] &
			BitTable[H & (CHAR_BITS-1)]))
	    return 0;		/* bad spelling */
    }
    return 1;			/* result = ok */
}

/* MLisp function to check the spelling of one word */
static
CheckSpelling()
{
    char   *word = getstr (": check-spelling ");

    MLvalue -> exp_type = IsInteger;
    MLvalue -> exp_int = Lookup(word);
    return 0;
}

/* insert word in the table */
static
InsertWord(word)
char *word;
{
    register    i,		/* index over hash tables */
                conflict = 1;	/* reset if word not already in table */
    register char  *cp;
    register unsigned short H;
    register struct HashTab *htp;

    if (!word || !*word)
	return 0;
    if (!SpellTab) {
	error ("Spelling table undefined");
	return 0;
    }
    for (i = 0, htp = SpellTab; i < N_HASH; i++, htp++) {
	for (H = 0, cp = word; *cp;) {
	    H = (H & 0x8000) ? (H << 1) + 1 : (H << 1);
	    H ^= htp -> Exor[*cp++ & (N_EXOR - 1)];
	}
	conflict &= ((htp -> Table[(H >> 3) & (N_TABLE - 1)] &
				    BitTable[H & (CHAR_BITS - 1)]) != 0);
	htp -> Table[(H >> 3) & (N_TABLE - 1)] |= BitTable[H & (CHAR_BITS - 1)];
    }
    return conflict;
}

/* internal function which suggests alternate spelling of word */
#define Accept(w)	(InsStr(w), InsCStr("\n", 1), result++)
static
SugSpell(word)
char *word;
{
    register    i,
                j,
                result = 0;
    register    length = strlen (word);
    char    buf[100];

    if (length < 2)
	return 0;
    if (length > 100 - 2) {
	InsStr (word);
	InsStr (" too long!");
	return 1;
    }
 /* delete letters */
    for (i = 0; i < length; i++) {
	strncpy (buf, word, i);
	strncpy (buf + i, word + i + 1, length - i - 1);
	buf[length-1] = '\0';
	if (Lookup (buf))
	    Accept (buf);
    }
 /* change letters */
    for (i = 0; i < length; i++) {
	strcpy (buf, word);
	for (j = 'A'; j <= 'Z'; j++) {
	    if ((buf[i] & 0xdf) == j)
		continue;
	    buf[i] = j | (buf[i] & 0x20);	/* retain same case */
	    if (Lookup (buf))
		Accept (buf);
	}
    }
/* transpose letters */
    for (i = 0; i < length - 1; i++) {
	strcpy (buf, word);
	j = buf[i];
	buf[i] = buf[i + 1];
	buf[i + 1] = j;
	if (Lookup (buf))
	    Accept (buf);
    }
/* insert letters */
    for (i = 0; i <= length; i++)
	for (j = 'A'; j <= 'Z'; j++) {
	    strncpy (buf, word, i);
	    buf[i] = j | ((i < length ? word[i] : word[i-1]) & 0x20);
	    strncpy (buf + i + 1, word + i, length - i);
	    buf[length + 1] = '\0';
	    if (Lookup (buf))
		Accept (buf);
	}
    return result;
}

/* MLisp function which generates suggested alternate spellings of a word */
static
SuggestSpellings()
{
    char   *word = getstr (": suggest-spellings for ");
    char    bword[100];
    char   *buffer;
    struct buffer  *this_buffer;

    if (!word || !*word)
	return 0;
    strncpy (bword, word, 100);
    buffer = getstr (": suggest-spellings for %s in buffer ", bword);
    if (!buffer)
	return 0;
    if (!*buffer)
	buffer = "Spellings";
    this_buffer = bf_cur;
    SetBfn (buffer);
    EraseBuffer ();
    MLvalue -> exp_type = IsInteger;
    MLvalue -> exp_int = SugSpell (bword);
    SetBfp (this_buffer);
    return 0;
}

/* MLisp function which asserts a word in the table */
static
AssertSpelling()
{
    char *word = getstr (": assert-spelling ");

    MLvalue -> exp_type = IsInteger;
    MLvalue -> exp_int = InsertWord(word);
    return 0;
}

/* MLisp function which asserts all words in a file */
static
AssertFile()
{
    register    i,
                conflicts = 0;
    register char  *cp;
    char   *fn = getstr (": assert-file ");
    char    ffn[MaxPathNameLen],
            buf[BUFSIZ];
    FILE * input;

    MLvalue -> exp_type = IsInteger;
    MLvalue -> exp_int = 0;	/* conflict count */
    if (!fn || !*fn)
	return 0;
    if (abspath (fn, ffn) == -1 || (input = fopen (ffn, "r")) == NULL) {
	error ("Can't open %s", ffn);
	return 0;
    }
    while (!feof (input)) {
	cp = buf;
	while ((*cp = getc (input)) != EOF)
	    if (*cp > ' ')
		break;
	while ((*++cp = getc (input)) != EOF)
	    if (*cp <= ' ')
		break;
	*cp = '\0';
	if (cp - buf > 2)
	    conflicts += InsertWord (buf);
    }
    fclose (input);
    MLvalue -> exp_int = conflicts;
    return 0;
}

/* MLisp function which calculates the percentage of bits set in the table */
static
SpellTabLoading()
{
    register    i,
                j,
                sum = 0;
    register struct HashTab *htp;
    register unsigned char *cp;
    static char BitCount[] = {
	0, 1, 1, 2, 1, 2, 2, 3,
	1, 2, 2, 3, 2, 3, 3, 4
    };

    if (!SpellTab) {
	error ("Spelling table undefined");
	return 0;
    }
    for (i = 0, htp = SpellTab; i < N_HASH; i++, htp++)
	for (j = 0, cp = htp -> Table; j < N_TABLE; j++, cp++) {
	    sum += BitCount[*cp & 15];
	    sum += BitCount[(*cp >> 4) & 15];
	}
    MLvalue -> exp_type = IsInteger;
    MLvalue -> exp_int = (sum * 100) / (N_TABLE * CHAR_BITS * N_HASH);
				/* percent loading */
    return 0;
}

InitSpell()
{
    defproc (ReadSpellTab, "read-spelltab");
    defproc (WriteSpellTab, "write-spelltab");
    defproc (CreateSpellTab, "create-spelltab");
    defproc (CheckSpelling, "check-spelling");
    defproc (SuggestSpellings, "suggest-spellings");
    defproc (AssertSpelling, "assert-spelling");
    defproc (AssertFile, "assert-file");
    defproc (SpellTabLoading, "spelltab-loading");
}