davidsen@steinmetz.UUCP (William E. Davidsen Jr) (06/15/87)
:
#!/bin/sh
# shar+ created from directory /usr2/davidsen/emacs38i
# 13:42 on Thu Jun 11, 1987 by davidsen
echo 'x - search.c (text)'
sed << 'E!O!F' 's/^X//' > search.c
X/*
X * The functions in this file implement commands that search in the forward
X * and backward directions. There are no special characters in the search
X * strings. Probably should have a regular expression search, or something
X * like that.
X *
X * Aug. 1986 John M. Gamble:
X * Made forward and reverse search use the same scan routine.
X *
X * Added a limited number of regular expressions - 'any',
X * 'character class', 'closure', 'beginning of line', and
X * 'end of line'.
X *
X * Replacement metacharacters will have to wait for a re-write of
X * the replaces function, and a new variation of ldelete().
X *
X * For those curious as to my references, i made use of
X * Kernighan & Plauger's "Software Tools."
X * I deliberately did not look at any published grep or editor
X * source (aside from this one) for inspiration. I did make use of
X * Allen Hollub's bitmap routines as published in Doctor Dobb's Journal,
X * June, 1985 and modified them for the limited needs of character class
X * matching. Any inefficiences, bugs, stupid coding examples, etc.,
X * are therefore my own responsibility.
X *
X * April 1987: John M. Gamble
X * Deleted the "if (n == 0) n = 1;" statements in front of the
X * search/hunt routines. Since we now use a do loop, these
X * checks are unnecessary. Consolidated common code into the
X * function delins(). Renamed global mclen matchlen,
X * and added the globals matchline, matchoff, patmatch, and
X * mlenold.
X * This gave us the ability to unreplace regular expression searches,
X * and to put the matched string into an evironment variable.
X * SOON TO COME: Meta-replacement characters!
X *
X * 25-apr-87 DML
X * - cleaned up an unneccessary if/else in forwsearch() and
X * backsearch()
X * - savematch() failed to malloc room for the terminating byte
X * of the match string (stomp...stomp...). It does now. Also
X * it now returns gracefully if malloc fails
X */
X
X#include <stdio.h>
X#include "estruct.h"
X#include "edef.h"
X
X
X/*
X * forwsearch -- Search forward. Get a search string from the user, and
X * search for the string. If found, reset the "." to be just after
X * the match string, and (perhaps) repaint the display.
X */
X
Xforwsearch(f, n)
X
Xint f, n; /* default flag / numeric argument */
X
X{
X register int status = TRUE;
X
X /* If n is negative, search backwards.
X * Otherwise proceed by asking for the search string.
X */
X if (n < 0)
X return(backsearch(f, -n));
X
X /* Ask the user for the text of a pattern. If the
X * response is TRUE (responses other than FALSE are
X * possible), search for the pattern for as long as
X * n is positive (n == 0 will go through once, which
X * is just fine).
X */
X if ((status = readpattern("Search", &pat[0], TRUE)) == TRUE) {
X do {
X#if MAGIC
X if ((magical && curwp->w_bufp->b_mode & MDMAGIC) != 0)
X status = mcscanner(&mcpat[0], FORWARD, PTEND);
X else
X#endif
X status = scanner(&pat[0], FORWARD, PTEND);
X } while ((--n > 0) && status);
X
X /* Save away the match, or complain
X * if not there.
X */
X if (status == TRUE)
X savematch();
X else
X mlwrite("Not found");
X }
X return(status);
X}
X
X/*
X * forwhunt -- Search forward for a previously acquired search string.
X * If found, reset the "." to be just after the match string,
X * and (perhaps) repaint the display.
X */
X
Xforwhunt(f, n)
X
Xint f, n; /* default flag / numeric argument */
X
X{
X register int status = TRUE;
X
X if (n < 0) /* search backwards */
X return(backhunt(f, -n));
X
X /* Make sure a pattern exists, or that we didn't switch
X * into MAGIC mode until after we entered the pattern.
X */
X if (pat[0] == '\0')
X {
X mlwrite("No pattern set");
X return FALSE;
X }
X#if MAGIC
X if ((curwp->w_bufp->b_mode & MDMAGIC) != 0 &&
X mcpat[0].mc_type == MCNIL)
X {
X if (!mcstr())
X return FALSE;
X }
X#endif
X
X /* Search for the pattern for as long as
X * n is positive (n == 0 will go through once, which
X * is just fine).
X */
X do
X {
X#if MAGIC
X if ((magical && curwp->w_bufp->b_mode & MDMAGIC) != 0)
X status = mcscanner(&mcpat[0], FORWARD, PTEND);
X else
X#endif
X status = scanner(&pat[0], FORWARD, PTEND);
X } while ((--n > 0) && status);
X
X /* Save away the match, or complain
X * if not there.
X */
X if (status == TRUE)
X savematch();
X else
X mlwrite("Not found");
X
X return(status);
X}
X
X/*
X * backsearch -- Reverse search. Get a search string from the user, and
X * search, starting at "." and proceeding toward the front of the buffer.
X * If found "." is left pointing at the first character of the pattern
X * (the last character that was matched).
X */
Xbacksearch(f, n)
X
Xint f, n; /* default flag / numeric argument */
X
X{
X register int status = TRUE;
X
X /* If n is negative, search forwards.
X * Otherwise proceed by asking for the search string.
X */
X if (n < 0)
X return(forwsearch(f, -n));
X
X /* Ask the user for the text of a pattern. If the
X * response is TRUE (responses other than FALSE are
X * possible), search for the pattern for as long as
X * n is positive (n == 0 will go through once, which
X * is just fine).
X */
X if ((status = readpattern("Reverse search", &pat[0], TRUE)) == TRUE) {
X do {
X#if MAGIC
X if ((magical && curwp->w_bufp->b_mode & MDMAGIC) != 0)
X status = mcscanner(&tapcm[0], REVERSE, PTBEG);
X else
X#endif
X status = scanner(&tap[0], REVERSE, PTBEG);
X } while ((--n > 0) && status);
X
X /* Save away the match, or complain
X * if not there.
X */
X if (status == TRUE)
X savematch();
X else
X mlwrite("Not found");
X }
X return(status);
X}
X
X/*
X * backhunt -- Reverse search for a previously acquired search string,
X * starting at "." and proceeding toward the front of the buffer.
X * If found "." is left pointing at the first character of the pattern
X * (the last character that was matched).
X */
Xbackhunt(f, n)
X
Xint f, n; /* default flag / numeric argument */
X
X{
X register int status = TRUE;
X
X if (n < 0)
X return(forwhunt(f, -n));
X
X /* Make sure a pattern exists, or that we didn't switch
X * into MAGIC mode until after we entered the pattern.
X */
X if (tap[0] == '\0')
X {
X mlwrite("No pattern set");
X return FALSE;
X }
X#if MAGIC
X if ((curwp->w_bufp->b_mode & MDMAGIC) != 0 &&
X tapcm[0].mc_type == MCNIL)
X {
X if (!mcstr())
X return FALSE;
X }
X#endif
X
X /* Go search for it for as long as
X * n is positive (n == 0 will go through once, which
X * is just fine).
X */
X do
X {
X#if MAGIC
X if ((magical && curwp->w_bufp->b_mode & MDMAGIC) != 0)
X status = mcscanner(&tapcm[0], REVERSE, PTBEG);
X else
X#endif
X status = scanner(&tap[0], REVERSE, PTBEG);
X } while ((--n > 0) && status);
X
X /* Save away the match, or complain
X * if not there.
X */
X if (status == TRUE)
X savematch();
X else
X mlwrite("Not found");
X
X return(status);
X}
X
X#if MAGIC
X/*
X * mcscanner -- Search for a meta-pattern in either direction. If found,
X * reset the "." to be at the start or just after the match string,
X * and (perhaps) repaint the display.
X */
Xint mcscanner(mcpatrn, direct, beg_or_end)
XMC *mcpatrn; /* pointer into pattern */
Xint direct; /* which way to go.*/
Xint beg_or_end; /* put point at beginning or end of pattern.*/
X{
X LINE *curline; /* current line during scan */
X int curoff; /* position within current line */
X int c; /* (dummy) char at current position */
X
X /* If we are going in reverse, then the 'end' is actually
X * the beginning of the pattern. Toggle it.
X */
X beg_or_end ^= direct;
X
X /*
X * Save the old matchlen length, in case it is
X * horribly different (closure) from the old length.
X * This is terribly important for query-replace undo
X * command.
X */
X mlenold = matchlen;
X
X /* Setup local scan pointers to global ".".
X */
X curline = curwp->w_dotp;
X curoff = curwp->w_doto;
X
X /* Scan each character until we hit the head link record.
X */
X while (!boundry(curline, curoff, direct))
X {
X /* Save the current position in case we need to
X * restore it on a match, and initialize matchlen to
X * zero in case we are doing a search for replacement.
X */
X matchline = curline;
X matchoff = curoff;
X matchlen = 0;
X
X if (amatch(mcpatrn, direct, &curline, &curoff))
X {
X /* A SUCCESSFULL MATCH!!!
X * reset the global "." pointers.
X */
X if (beg_or_end == PTEND) /* at end of string */
X {
X curwp->w_dotp = curline;
X curwp->w_doto = curoff;
X }
X else /* at beginning of string */
X {
X curwp->w_dotp = matchline;
X curwp->w_doto = matchoff;
X }
X
X curwp->w_flag |= WFMOVE; /* flag that we have moved */
X return TRUE;
X }
X
X /* Advance the cursor.
X */
X c = nextch(&curline, &curoff, direct);
X }
X
X return FALSE; /* We could not find a match.*/
X}
X
X/*
X * amatch -- Search for a meta-pattern in either direction. Based on the
X * recursive routine amatch() (for "anchored match") in
X * Kernighan & Plauger's "Software Tools".
X */
Xstatic int amatch(mcptr, direct, pcwline, pcwoff)
Xregister MC *mcptr; /* string to scan for */
Xint direct; /* which way to go.*/
XLINE **pcwline; /* current line during scan */
Xint *pcwoff; /* position within current line */
X{
X register int c; /* character at current position */
X LINE *curline; /* current line during scan */
X int curoff; /* position within current line */
X int nchars;
X
X /* Set up local scan pointers to ".", and get
X * the current character. Then loop around
X * the pattern pointer until success or failure.
X */
X curline = *pcwline;
X curoff = *pcwoff;
X
X /* The beginning-of-line and end-of-line metacharacters
X * do not compare against characters, they compare
X * against positions.
X * BOL is guaranteed to be at the start of the pattern
X * for forward searches, and at the end of the pattern
X * for reverse searches. The reverse is true for EOL.
X * So, for a start, we check for them on entry.
X */
X if (mcptr->mc_type == BOL)
X {
X if (curoff != 0)
X return FALSE;
X mcptr++;
X }
X
X if (mcptr->mc_type == EOL)
X {
X if (curoff != llength(curline))
X return FALSE;
X mcptr++;
X }
X
X while (mcptr->mc_type != MCNIL)
X {
X c = nextch(&curline, &curoff, direct);
X
X if (mcptr->mc_type & CLOSURE)
X {
X /* Try to match as many characters as possible
X * against the current meta-character. A
X * newline never matches a closure.
X */
X nchars = 0;
X while (c != '\n' && mceq(c, mcptr))
X {
X c = nextch(&curline, &curoff, direct);
X nchars++;
X }
X
X /* We are now at the character that made us
X * fail. Try to match the rest of the pattern.
X * Shrink the closure by one for each failure.
X * Since closure matches *zero* or more occurences
X * of a pattern, a match may start even if the
X * previous loop matched no characters.
X */
X mcptr++;
X
X for (;;)
X {
X c = nextch(&curline, &curoff, direct ^ REVERSE);
X
X if (amatch(mcptr, direct, &curline, &curoff))
X {
X matchlen += nchars;
X goto success;
X }
X
X if (nchars-- == 0)
X return FALSE;
X }
X }
X else /* Not closure.*/
X {
X /* The only way we'd get a BOL metacharacter
X * at this point is at the end of the reversed pattern.
X * The only way we'd get an EOL metacharacter
X * here is at the end of a regular pattern.
X * So if we match one or the other, and are at
X * the appropriate position, we are guaranteed success
X * (since the next pattern character has to be MCNIL).
X * Before we report success, however, we back up by
X * one character, so as to leave the cursor in the
X * correct position. For example, a search for ")$"
X * will leave the cursor at the end of the line, while
X * a search for ")<NL>" will leave the cursor at the
X * beginning of the next line. This follows the
X * notion that the meta-character '$' (and likewise
X * '^') match positions, not characters.
X */
X if (mcptr->mc_type == BOL)
X if (curoff == llength(curline))
X {
X c = nextch(&curline, &curoff,
X direct ^ REVERSE);
X goto success;
X }
X else
X return FALSE;
X
X if (mcptr->mc_type == EOL)
X if (curoff == 0)
X {
X c = nextch(&curline, &curoff,
X direct ^ REVERSE);
X goto success;
X }
X else
X return FALSE;
X
X /* Neither BOL nor EOL, so go through
X * the meta-character equal function.
X */
X if (!mceq(c, mcptr))
X return FALSE;
X }
X
X /* Increment the length counter and
X * advance the pattern pointer.
X */
X matchlen++;
X mcptr++;
X } /* End of mcptr loop.*/
X
X /* A SUCCESSFULL MATCH!!!
X * Reset the "." pointers.
X */
Xsuccess:
X *pcwline = curline;
X *pcwoff = curoff;
X
X return TRUE;
X}
X#endif
X
X/*
X * scanner -- Search for a pattern in either direction. If found,
X * reset the "." to be at the start or just after the match string,
X * and (perhaps) repaint the display.
X */
Xint scanner(patrn, direct, beg_or_end)
Xchar *patrn; /* string to scan for */
Xint direct; /* which way to go.*/
Xint beg_or_end; /* put point at beginning or end of pattern.*/
X{
X register int c; /* character at current position */
X register char *patptr; /* pointer into pattern */
X LINE *curline; /* current line during scan */
X int curoff; /* position within current line */
X LINE *scanline; /* current line during scanning */
X int scanoff; /* position in scanned line */
X
X /* If we are going in reverse, then the 'end' is actually
X * the beginning of the pattern. Toggle it.
X */
X beg_or_end ^= direct;
X
X /* Set up local pointers to global ".".
X */
X curline = curwp->w_dotp;
X curoff = curwp->w_doto;
X
X /* Scan each character until we hit the head link record.
X */
X while (!boundry(curline, curoff, direct))
X {
X /* Save the current position in case we match
X * the search string at this point.
X */
X matchline = curline;
X matchoff = curoff;
X
X /* Get the character resolving newlines, and
X * test it against first char in pattern.
X */
X c = nextch(&curline, &curoff, direct);
X
X if (eq(c, patrn[0])) /* if we find it..*/
X {
X /* Setup scanning pointers.
X */
X scanline = curline;
X scanoff = curoff;
X patptr = &patrn[0];
X
X /* Scan through the pattern for a match.
X */
X while (*++patptr != '\0')
X {
X c = nextch(&scanline, &scanoff, direct);
X
X if (!eq(c, *patptr))
X goto fail;
X }
X
X /* A SUCCESSFULL MATCH!!!
X * reset the global "." pointers
X */
X if (beg_or_end == PTEND) /* at end of string */
X {
X curwp->w_dotp = scanline;
X curwp->w_doto = scanoff;
X }
X else /* at beginning of string */
X {
X curwp->w_dotp = matchline;
X curwp->w_doto = matchoff;
X }
X
X curwp->w_flag |= WFMOVE; /* Flag that we have moved.*/
X return TRUE;
X
X }
Xfail:; /* continue to search */
X }
X
X return FALSE; /* We could not find a match */
X}
X
X/*
X * eq -- Compare two characters. The "bc" comes from the buffer, "pc"
X * from the pattern. If we are not in EXACT mode, fold out the case.
X */
Xint eq(bc, pc)
Xregister int bc;
Xregister int pc;
X{
X if ((curwp->w_bufp->b_mode & MDEXACT) == 0)
X {
X if (islower(bc))
X bc ^= DIFCASE;
X
X if (islower(pc))
X pc ^= DIFCASE;
X }
X
X return (bc == pc);
X}
X
X/*
X * readpattern -- Read a pattern. Stash it in apat. If it is the
X * search string, create the reverse pattern and the magic
X * pattern, assuming we are in MAGIC mode (and defined that way).
X * Apat is not updated if the user types in an empty line. If
X * the user typed an empty line, and there is no old pattern, it is
X * an error. Display the old pattern, in the style of Jeff Lomicka.
X * There is some do-it-yourself control expansion. Change to using
X * <META> to delimit the end-of-pattern to allow <NL>s in the search
X * string.
X */
Xstatic int readpattern(prompt, apat, srch)
Xchar *prompt;
Xchar apat[];
Xint srch;
X{
X int status;
X char tpat[NPAT+20];
X
X strcpy(tpat, prompt); /* copy prompt to output string */
X strcat(tpat, " ["); /* build new prompt string */
X expandp(&apat[0], &tpat[strlen(tpat)], NPAT/2); /* add old pattern */
X strcat(tpat, "]<META>: ");
X
X /* Read a pattern. Either we get one,
X * or we just get the META charater, and use the previous pattern.
X * Then, if it's the search string, make a reversed pattern.
X * *Then*, make the meta-pattern, if we are defined that way.
X */
X if ((status = mlreplyt(tpat, tpat, NPAT, metac)) == TRUE)
X {
X strcpy(apat, tpat);
X if (srch) /* If we are doing the search string.*/
X {
X matchlen = strlen(apat);
X /* Reverse string copy.
X */
X rvstrcpy(tap, apat);
X#if MAGIC
X /* Only make the meta-pattern if in magic mode,
X * since the pattern in question might have an
X * invalid meta combination.
X */
X if ((curwp->w_bufp->b_mode & MDMAGIC) == 0)
X mcclear();
X else
X status = mcstr();
X#endif
X }
X }
X else if (status == FALSE && apat[0] != 0) /* Old one */
X status = TRUE;
X
X return(status);
X}
X
X/*
X * savematch -- We found the pattern? Let's save it away.
X */
X
Xsavematch()
X
X{
X register char *ptr; /* ptr into malloced last match string */
X register int j; /* index */
X LINE *curline; /* line of last match */
X int curoff; /* offset " " */
X
X /* free any existing match string */
X if (patmatch != NULL)
X free(patmatch);
X
X /* attempt to allocate a new one */
X ptr = patmatch = malloc(matchlen + 1);
X if (ptr == NULL)
X return;
X
X /* save the match! */
X curoff = matchoff;
X curline = matchline;
X
X for (j = 0; j < matchlen; j++)
X *ptr++ = nextch(&curline, &curoff, FORWARD);
X
X /* null terminate the match string */
X *ptr = '\0';
X}
X
X/*
X * rvstrcpy -- Reverse string copy.
X */
Xrvstrcpy(rvstr, str)
Xregister char *rvstr, *str;
X{
X register int i;
X
X str += (i = strlen(str));
X
X while (i-- > 0)
X *rvstr++ = *--str;
X
X *rvstr = '\0';
X}
X
X/*
X * sreplace -- Search and replace.
X */
Xsreplace(f, n)
X
Xint f; /* default flag */
Xint n; /* # of repetitions wanted */
X
X{
X return(replaces(FALSE, f, n));
X}
X
X/*
X * qreplace -- search and replace with query.
X */
Xqreplace(f, n)
Xint f; /* default flag */
Xint n; /* # of repetitions wanted */
X{
X return(replaces(TRUE, f, n));
X}
X
X/*
X * replaces -- Search for a string and replace it with another
X * string. Query might be enabled (according to kind).
X */
Xstatic int replaces(kind, f, n)
Xint kind; /* Query enabled flag */
Xint f; /* default flag */
Xint n; /* # of repetitions wanted */
X{
X register int status; /* success flag on pattern inputs */
X register int rlength; /* length of replacement string */
X register int numsub; /* number of substitutions */
X register int nummatch; /* number of found matches */
X int nlflag; /* last char of search string a <NL>? */
X int nlrepl; /* was a replace done on the last line? */
X char c; /* input char for query */
X char tpat[NPAT]; /* temporary to hold search pattern */
X LINE *origline; /* original "." position */
X int origoff; /* and offset (for . query option) */
X LINE *lastline; /* position of last replace and */
X int lastoff; /* offset (for 'u' query option) */
X
X if (curbp->b_mode & MDVIEW) /* don't allow this command if */
X return(rdonly()); /* we are in read only mode */
X
X /* Check for negative repetitions.
X */
X if (f && n < 0)
X return(FALSE);
X
X /* Ask the user for the text of a pattern.
X */
X if ((status = readpattern(
X (kind == FALSE ? "Replace" : "Query replace"), &pat[0], TRUE))
X != TRUE)
X return(status);
X
X /* Ask for the replacement string.
X */
X if ((status = readpattern("with", &rpat[0], FALSE)) == ABORT)
X return(status);
X
X /* Find the length of the replacement string.
X */
X rlength = strlen(&rpat[0]);
X
X /* Set up flags so we can make sure not to do a recursive
X * replace on the last line.
X */
X nlflag = (pat[matchlen - 1] == '\n');
X nlrepl = FALSE;
X
X if (kind)
X {
X /* Build query replace question string.
X */
X strcpy(tpat, "Replace '");
X expandp(&pat[0], &tpat[strlen(tpat)], NPAT/3);
X strcat(tpat, "' with '");
X expandp(&rpat[0], &tpat[strlen(tpat)], NPAT/3);
X strcat(tpat, "'? ");
X
X /* Initialize last replaced pointers.
X */
X lastline = NULL;
X lastoff = 0;
X }
X
X /* Save original . position, init the number of matches and
X * substitutions, and scan through the file.
X */
X origline = curwp->w_dotp;
X origoff = curwp->w_doto;
X numsub = 0;
X nummatch = 0;
X
X while ( (f == FALSE || n > nummatch) &&
X (nlflag == FALSE || nlrepl == FALSE) )
X {
X /* Search for the pattern.
X * If we search with a regular expression,
X * matchlen is reset to the true length of
X * the matched string.
X */
X#if MAGIC
X if ((magical && curwp->w_bufp->b_mode & MDMAGIC) != 0)
X {
X if (!mcscanner(&mcpat[0], FORWARD, PTBEG))
X break;
X }
X else
X#endif
X if (!scanner(&pat[0], FORWARD, PTBEG))
X break; /* all done */
X
X ++nummatch; /* Increment # of matches */
X
X /* Check if we are on the last line.
X */
X nlrepl = (lforw(curwp->w_dotp) == curwp->w_bufp->b_linep);
X
X /* Check for query.
X */
X if (kind)
X {
X /* Get the query.
X */
Xpprompt: mlwrite(&tpat[0], &pat[0], &rpat[0]);
Xqprompt:
X update(TRUE); /* show the proposed place to change */
X c = tgetc(); /* and input */
X mlwrite(""); /* and clear it */
X
X /* And respond appropriately.
X */
X switch (c)
X {
X case 'y': /* yes, substitute */
X case ' ':
X savematch();
X break;
X
X case 'n': /* no, onword */
X forwchar(FALSE, 1);
X continue;
X
X case '!': /* yes/stop asking */
X kind = FALSE;
X break;
X
X case 'u': /* undo last and re-prompt */
X
X /* Restore old position.
X */
X if (lastline == NULL)
X {
X /* There is nothing to undo.
X */
X TTbeep();
X goto pprompt;
X }
X curwp->w_dotp = lastline;
X curwp->w_doto = lastoff;
X lastline = NULL;
X lastoff = 0;
X
X /* Delete the new string.
X */
X backchar(FALSE, rlength);
X status = delins(rlength, patmatch);
X if (status != TRUE)
X return (status);
X
X /* Record one less substitution,
X * backup, and reprompt.
X */
X --numsub;
X backchar(FALSE, mlenold);
X goto pprompt;
X
X case '.': /* abort! and return */
X /* restore old position */
X curwp->w_dotp = origline;
X curwp->w_doto = origoff;
X curwp->w_flag |= WFMOVE;
X
X case BELL: /* abort! and stay */
X mlwrite("Aborted!");
X return(FALSE);
X
X default: /* bitch and beep */
X TTbeep();
X
X case '?': /* help me */
X mlwrite(
X"(Y)es, (N)o, (!)Do rest, (U)ndo last, (^G)Abort, (.)Abort back, (?)Help: ");
X goto qprompt;
X
X } /* end of switch */
X } /* end of "if kind" */
X
X /*
X * Delete the sucker, and insert its
X * replacement.
X */
X status = delins(matchlen, &rpat[0]);
X if (status != TRUE)
X return (status);
X
X /* Save where we are if we might undo this....
X */
X if (kind)
X {
X lastline = curwp->w_dotp;
X lastoff = curwp->w_doto;
X }
X
X numsub++; /* increment # of substitutions */
X }
X
X /* And report the results.
X */
X mlwrite("%d substitutions", numsub);
X return(TRUE);
X}
X
X/*
X * delins -- Delete a specified length from the current
X * point, then insert the string.
X */
Xdelins(dlength, instr)
Xint dlength;
Xchar *instr;
X{
X int status;
X char tmpc;
X
X /* Zap what we gotta,
X * and insert its replacement.
X */
X if (!(status = ldelete((long) dlength, FALSE)))
X {
X mlwrite("%%ERROR while deleting");
X return(FALSE);
X }
X else
X while (tmpc = *instr)
X {
X status = (tmpc == '\n'? lnewline(): linsert(1, tmpc));
X
X /* Insertion error?
X */
X if (!status)
X {
X mlwrite("%%Out of memory while inserting");
X break;
X }
X instr++;
X }
X return (status);
X}
X
X/*
X * expandp -- Expand control key sequences for output.
X */
Xexpandp(srcstr, deststr, maxlength)
Xchar *srcstr; /* string to expand */
Xchar *deststr; /* destination of expanded string */
Xint maxlength; /* maximum chars in destination */
X{
X char c; /* current char to translate */
X
X /* Scan through the string.
X */
X while ((c = *srcstr++) != 0)
X {
X if (c == '\n') /* it's a newline */
X {
X *deststr++ = '<';
X *deststr++ = 'N';
X *deststr++ = 'L';
X *deststr++ = '>';
X maxlength -= 4;
X }
X else if (c < 0x20 || c == 0x7f) /* control character */
X {
X *deststr++ = '^';
X *deststr++ = c ^ 0x40;
X maxlength -= 2;
X }
X else if (c == '%')
X {
X *deststr++ = '%';
X *deststr++ = '%';
X maxlength -= 2;
X }
X else /* any other character */
X {
X *deststr++ = c;
X maxlength--;
X }
X
X /* check for maxlength */
X if (maxlength < 4)
X {
X *deststr++ = '$';
X *deststr = '\0';
X return(FALSE);
X }
X }
X *deststr = '\0';
X return(TRUE);
X}
X
X/*
X * boundry -- Return information depending on whether we may search no
X * further. Beginning of file and end of file are the obvious
X * cases, but we may want to add further optional boundry restrictions
X * in future, a' la VMS EDT. At the moment, just return TRUE or
X * FALSE depending on if a boundry is hit (ouch).
X */
Xint boundry(curline, curoff, dir)
XLINE *curline;
Xint curoff, dir;
X{
X register int border;
X
X if (dir == FORWARD)
X {
X border = (curoff == llength(curline)) &&
X (lforw(curline) == curbp->b_linep);
X }
X else
X {
X border = (curoff == 0) &&
X (lback(curline) == curbp->b_linep);
X }
X return (border);
X}
X
X/*
X * nextch -- retrieve the next/previous character in the buffer,
X * and advance/retreat the point.
X * The order in which this is done is significant, and depends
X * upon the direction of the search. Forward searches look at
X * the current character and move, reverse searches move and
X * look at the character.
X */
Xstatic int nextch(pcurline, pcuroff, dir)
XLINE **pcurline;
Xint *pcuroff;
Xint dir;
X{
X register LINE *curline;
X register int curoff;
X register int c;
X
X curline = *pcurline;
X curoff = *pcuroff;
X
X if (dir == FORWARD)
X {
X if (curoff == llength(curline)) /* if at EOL */
X {
X curline = lforw(curline); /* skip to next line */
X curoff = 0;
X c = '\n'; /* and return a <NL> */
X }
X else
X c = lgetc(curline, curoff++); /* get the char */
X }
X else /* Reverse.*/
X {
X if (curoff == 0)
X {
X curline = lback(curline);
X curoff = llength(curline);
X c = '\n';
X }
X else
X c = lgetc(curline, --curoff);
X
X }
X *pcurline = curline;
X *pcuroff = curoff;
X
X return (c);
X}
X
X#if MAGIC
X/*
X * mcstr -- Set up the 'magic' array. The closure symbol is taken as
X * a literal character when (1) it is the first character in the
X * pattern, and (2) when preceded by a symbol that does not allow
X * closure, such as a newline, beginning of line symbol, or another
X * closure symbol.
X *
X * Coding comment (jmg): yes, i know i have gotos that are, strictly
X * speaking, unnecessary. But right now we are so cramped for
X * code space that i will grab what i can in order to remain
X * within the 64K limit. C compilers actually do very little
X * in the way of optimizing - they expect you to do that.
X */
Xint mcstr()
X{
X MC *mcptr, *rtpcm;
X char *patptr;
X int mj;
X int pchr;
X int status = TRUE;
X int does_closure = FALSE;
X
X /* If we had metacharacters in the MC array previously,
X * free up any bitmaps that may have been allocated.
X */
X if (magical)
X mcclear();
X
X magical = FALSE;
X mj = 0;
X mcptr = &mcpat[0];
X patptr = &pat[0];
X
X while ((pchr = *patptr) && status)
X {
X switch (pchr)
X {
X case MC_CCL:
X status = cclmake(&patptr, mcptr);
X magical = TRUE;
X does_closure = TRUE;
X break;
X case MC_BOL:
X if (mj != 0)
X goto litcase;
X
X mcptr->mc_type = BOL;
X magical = TRUE;
X does_closure = FALSE;
X break;
X case MC_EOL:
X if (*(patptr + 1) != '\0')
X goto litcase;
X
X mcptr->mc_type = EOL;
X magical = TRUE;
X does_closure = FALSE;
X break;
X case MC_ANY:
X mcptr->mc_type = ANY;
X magical = TRUE;
X does_closure = TRUE;
X break;
X case MC_CLOSURE:
X /* Does the closure symbol mean closure here?
X * If so, back up to the previous element
X * and indicate it is enclosed.
X */
X if (!does_closure)
X goto litcase;
X mj--;
X mcptr--;
X mcptr->mc_type |= CLOSURE;
X magical = TRUE;
X does_closure = FALSE;
X break;
X
X /* Note: no break between MC_ESC case and the default.
X */
X case MC_ESC:
X if (*(patptr + 1) != '\0')
X {
X pchr = *++patptr;
X magical = TRUE;
X }
X default:
Xlitcase: mcptr->mc_type = LITCHAR;
X mcptr->u.lchar = pchr;
X does_closure = (pchr != '\n');
X break;
X } /* End of switch.*/
X mcptr++;
X patptr++;
X mj++;
X } /* End of while.*/
X
X /* Close off the meta-string.
X */
X mcptr->mc_type = MCNIL;
X
X /* Set up the reverse array, if the status is good. Please note the
X * structure assignment - your compiler may not like that.
X * If the status is not good, nil out the meta-pattern.
X * The only way the status would be bad is from the cclmake()
X * routine, and the bitmap for that member is guarenteed to be
X * freed. So we stomp a MCNIL value there, and call mcclear()
X * to free any other bitmaps.
X */
X if (status)
X {
X rtpcm = &tapcm[0];
X while (--mj >= 0)
X {
X#if LATTICE
X movmem(--mcptr, rtpcm++, sizeof (MC));
X#endif
X
X#if MWC86 | AZTEC | MSC | VMS | USG | BSD | V7
X *rtpcm++ = *--mcptr;
X#endif
X }
X rtpcm->mc_type = MCNIL;
X }
X else
X {
X (--mcptr)->mc_type = MCNIL;
X mcclear();
X }
X
X return(status);
X}
X
X/*
X * mcclear -- Free up any CCL bitmaps, and MCNIL the MC arrays.
X */
Xmcclear()
X{
X register MC *mcptr;
X
X mcptr = &mcpat[0];
X
X while (mcptr->mc_type != MCNIL)
X {
X if ((mcptr->mc_type & MASKCL) == CCL ||
X (mcptr->mc_type & MASKCL) == NCCL)
X free(mcptr->u.cclmap);
X mcptr++;
X }
X mcpat[0].mc_type = tapcm[0].mc_type = MCNIL;
X}
X
X/*
X * mceq -- meta-character equality with a character. In Kernighan & Plauger's
X * Software Tools, this is the function omatch(), but i felt there
X * were too many functions with the 'match' name already.
X */
Xstatic int mceq(bc, mt)
Xint bc;
XMC *mt;
X{
X register int result;
X
X switch (mt->mc_type & MASKCL)
X {
X case LITCHAR:
X result = eq(bc, mt->u.lchar);
X break;
X
X case ANY:
X result = (bc != '\n');
X break;
X
X case CCL:
X if (!(result = biteq(bc, mt->u.cclmap)))
X {
X if ((curwp->w_bufp->b_mode & MDEXACT) == 0 &&
X (isletter(bc)))
X {
X result = biteq(CHCASE(bc), mt->u.cclmap);
X }
X }
X break;
X
X case NCCL:
X result = !biteq(bc, mt->u.cclmap);
X
X if ((curwp->w_bufp->b_mode & MDEXACT) == 0 &&
X (isletter(bc)))
X {
X result &= !biteq(CHCASE(bc), mt->u.cclmap);
X }
X break;
X
X default:
X mlwrite("mceq: what is %d?", mt->mc_type);
X result = FALSE;
X break;
X
X } /* End of switch.*/
X
X return (result);
X}
X
X/*
X * cclmake -- create the bitmap for the character class.
X * ppatptr is left pointing to the end-of-character-class character,
X * so that a loop may automatically increment with safety.
X */
Xstatic int cclmake(ppatptr, mcptr)
Xchar **ppatptr;
XMC *mcptr;
X{
X BITMAP clearbits();
X BITMAP bmap;
X register char *patptr;
X register int pchr, ochr;
X
X if ((bmap = clearbits()) == NULL)
X {
X mlwrite("%%Out of memory");
X return FALSE;
X }
X
X mcptr->u.cclmap = bmap;
X patptr = *ppatptr;
X
X /*
X * Test the initial character(s) in ccl for
X * special cases - negate ccl, or an end ccl
X * character as a first character. Anything
X * else gets set in the bitmap.
X */
X if (*++patptr == MC_NCCL)
X {
X patptr++;
X mcptr->mc_type = NCCL;
X }
X else
X mcptr->mc_type = CCL;
X
X if ((ochr = *patptr) == MC_ECCL)
X {
X mlwrite("%%No characters in character class");
X return (FALSE);
X }
X else
X {
X if (ochr == MC_ESC)
X ochr = *++patptr;
X
X setbit(ochr, bmap);
X patptr++;
X }
X
X while (ochr != '\0' && (pchr = *patptr) != MC_ECCL)
X {
X switch (pchr)
X {
X /* Range character loses its meaning
X * if it is the last character in
X * the class.
X */
X case MC_RCCL:
X if (*(patptr + 1) == MC_ECCL)
X setbit(pchr, bmap);
X else
X {
X pchr = *++patptr;
X while (++ochr <= pchr)
X setbit(ochr, bmap);
X }
X break;
X
X /* Note: no break between case MC_ESC and the default.
X */
X case MC_ESC:
X pchr = *++patptr;
X default:
X setbit(pchr, bmap);
X break;
X }
X patptr++;
X ochr = pchr;
X }
X
X *ppatptr = patptr;
X
X if (ochr == '\0')
X {
X mlwrite("%%Character class not ended");
X free(bmap);
X return FALSE;
X }
X return TRUE;
X}
X
X/*
X * biteq -- is the character in the bitmap?
X */
Xstatic int biteq(bc, cclmap)
Xint bc;
XBITMAP cclmap;
X{
X if (bc >= HICHAR)
X return FALSE;
X
X return( (*(cclmap + (bc >> 3)) & BIT(bc & 7))? TRUE: FALSE );
X}
X
X/*
X * clearbits -- Allocate and zero out a CCL bitmap.
X */
Xstatic BITMAP clearbits()
X{
X char *malloc();
X
X BITMAP cclstart, cclmap;
X register int j;
X
X if ((cclmap = cclstart = (BITMAP) malloc(HIBYTE)) != NULL)
X for (j = 0; j < HIBYTE; j++)
X *cclmap++ = 0;
X
X return (cclstart);
X}
X
X/*
X * setbit -- Set a bit (ON only) in the bitmap.
X */
Xstatic setbit(bc, cclmap)
Xint bc;
XBITMAP cclmap;
X{
X if (bc < HICHAR)
X *(cclmap + (bc >> 3)) |= BIT(bc & 7);
X}
X#endif
E!O!F
newsize=`wc -c < search.c`
if [ $newsize -ne 32143 ]
then echo "File search.c was $newsize bytes, 32143 expected"
fi
echo 'x - spawn.c (text)'
sed << 'E!O!F' 's/^X//' > spawn.c
X/* Spawn: various DOS access commands
X for MicroEMACS
X*/
X
X#include <stdio.h>
X#include "estruct.h"
X#include "edef.h"
X
X#if AMIGA
X#define NEW 1006
X#endif
X
X#if ST520 & MEGAMAX
X#include <osbind.h>
X#include <string.h>
X#define LOAD_EXEC 0 /* load and execute the program */
Xchar *STcmd, /* the command filename & path */
X *STargs, /* command args (if any) */
X *STenv, /* environment */
X *STwork; /* work area */
X#endif
X
X#if VMS
X#define EFN 0 /* Event flag. */
X
X#include <ssdef.h> /* Random headers. */
X#include <stsdef.h>
X#include <descrip.h>
X#include <iodef.h>
X
Xextern int oldmode[3]; /* In "termio.c" */
Xextern int newmode[3]; /* In "termio.c" */
Xextern short iochan; /* In "termio.c" */
X#endif
X
X#if V7 | USG | BSD
X#include <signal.h>
Xextern int vttidy();
X#endif
X
X#if MSDOS & MSC
X#include <process.h>
X#define system(a) spawnlp(P_WAIT, a, NULL)
X#endif
X
X/*
X * Create a subjob with a copy of the command intrepreter in it. When the
X * command interpreter exits, mark the screen as garbage so that you do a full
X * repaint. Bound to "^X C". The message at the start in VMS puts out a newline.
X * Under some (unknown) condition, you don't get one free when DCL starts up.
X */
Xspawncli(f, n)
X{
X#if AMIGA
X long newcli;
X
X#endif
X
X#if V7 | USG | BSD
X register char *cp;
X char *getenv();
X#endif
X
X /* don't allow this command if restricted */
X if (restflag)
X return(resterr());
X
X#if AMIGA
X newcli = Open("CON:0/0/639/199/MicroEmacs Subprocess", NEW);
X mlwrite("[Starting new CLI]");
X sgarbf = TRUE;
X Execute("", newcli, 0);
X Close(newcli);
X return(TRUE);
X#endif
X
X#if VMS
X movecursor(term.t_nrow, 0); /* In last line. */
X mlputs("[Starting DCL]\r\n");
X TTflush(); /* Ignore "ttcol". */
X sgarbf = TRUE;
X return (sys(NULL)); /* NULL => DCL. */
X#endif
X#if CPM
X mlwrite("Not in CP/M-86");
X#endif
X#if ST520
X mlwrite("Not in TOS");
X#endif
X#if MSDOS & AZTEC
X movecursor(term.t_nrow, 0); /* Seek to last line. */
X TTflush();
X TTkclose();
X system("command.com");
X TTkopen();
X sgarbf = TRUE;
X return(TRUE);
X#endif
X#if MSDOS & LATTICE
X movecursor(term.t_nrow, 0); /* Seek to last line. */
X TTflush();
X TTkclose();
X sys("\\command.com", ""); /* Run CLI. */
X TTkopen();
X sgarbf = TRUE;
X return(TRUE);
X#endif
X#if V7 | USG | BSD
X movecursor(term.t_nrow, 0); /* Seek to last line. */
X TTflush();
X TTclose(); /* stty to old settings */
X if ((cp = getenv("SHELL")) != NULL && *cp != '\0')
X system(cp);
X else
X#if BSD
X system("exec /bin/csh");
X#else
X system("exec /bin/sh");
X#endif
X sgarbf = TRUE;
X sleep(2);
X TTopen();
X return(TRUE);
X#endif
X}
X
X#if BSD
X
Xbktoshell() /* suspend MicroEMACS and wait to wake up */
X{
X int pid;
X
X vttidy();
X pid = getpid();
X kill(pid,SIGTSTP);
X}
X
Xrtfrmshell()
X{
X TTopen();
X curwp->w_flag = WFHARD;
X sgarbf = TRUE;
X}
X#endif
X
X/*
X * Run a one-liner in a subjob. When the command returns, wait for a single
X * character to be typed, then mark the screen as garbage so a full repaint is
X * done. Bound to "C-X !".
X */
Xspawn(f, n)
X{
X register int s;
X char line[NLINE];
X
X#if ST520 & MEGAMAX
X int i,j,k;
X char *sptr,*tptr;
X#endif
X
X#if AMIGA
X long newcli;
X#endif
X
X /* don't allow this command if restricted */
X if (restflag)
X return(resterr());
X
X#if AMIGA
X if ((s=mlreply("!", line, NLINE)) != TRUE)
X return (s);
X newcli = Open("CON:0/0/639/199/MicroEmacs Subprocess", NEW);
X Execute(line,0,newcli);
X Close(newcli);
X tgetc(); /* Pause. */
X sgarbf = TRUE;
X return(TRUE);
X#endif
X#if ST520 & MEGAMAX
X if ((s=mlreply("!", line, NLINE)) != TRUE)
X return(s);
X movecursor(term.t_nrow - 1, 0);
X TTclose();
X/*
X * break the line into the command and its args
X * be cute about it, if there is no '.' in the filename, try
X * to find .prg, .tos or .ttp in that order
X * in any case check to see that the file exists before we run
X * amok
X */
X STenv = NULL;
X if((tptr = index(&line[0],' ')) == NULL) { /* no args */
X STcmd = (char *)malloc(strlen(line) + 1);
X strcpy(STcmd,line);
X STargs = NULL;
X }
X else { /* seperate out the args from the command */
X /* resist the temptation to do ptr arithmetic */
X STcmd = (char *)malloc(strlen(line) + 1);
X for(i = 0,sptr = &line[0]; sptr != tptr; sptr++,i++)
X STcmd[i] = *sptr;
X STcmd[i] = '\0';
X for(; *tptr == ' ' || *tptr == '\t'; tptr++);
X if(*tptr == '\0')
X STargs = NULL;
X else {
X STargs = (char *)malloc(strlen(tptr) + 2);
X/* first byte of STargs is the length of the string */
X STargs[0] = strlen(tptr);
X STargs[1] = NULL; /* fake it for strcat */
X strcat(STargs,tptr);
X }
X }
X/*
X * before we issue the command look for the '.', if it's not there
X * try adding .prg, .tos and .ttp to see if they exist, if not
X * issue the command as is
X */
X if((tptr = index(STcmd,'.')) == NULL) {
X STwork = (char *)malloc(strlen(STcmd) + 4);
X strcpy(STwork,STcmd);
X strcat(STwork,".prg");
X tptr = index(STwork,'.');
X if(Fsfirst(1,STwork) != 0) { /* try .tos */
X strcpy(tptr,".tos");
X if(Fsfirst(1,STwork) != 0) { /* try .ttp */
X strcpy(tptr,".ttp");
X if(Fsfirst(1,STwork) != 0) /* never mind */
X *STwork = NULL;
X }
X }
X }
X if(*STwork != NULL)
X Pexec(LOAD_EXEC,STwork,STargs,STenv);
X else
X Pexec(LOAD_EXEC,STcmd,STargs,STenv);
X TTopen();
X mlputs("\r\n\n[End]"); /* Pause. */
X TTgetc(); /* Pause. */
X sgarbf = TRUE;
X return (TRUE);
X#endif
X#if VMS
X if ((s=mlreply("!", line, NLINE)) != TRUE)
X return (s);
X TTputc('\n'); /* Already have '\r' */
X TTflush();
X s = sys(line); /* Run the command. */
X mlputs("\r\n\n[End]"); /* Pause. */
X TTflush();
X tgetc();
X sgarbf = TRUE;
X return (s);
X#endif
X#if CPM
X mlwrite("Not in CP/M-86");
X return (FALSE);
X#endif
X#if MSDOS | (ST520 & LATTICE)
X if ((s=mlreply("!", line, NLINE)) != TRUE)
X return(s);
X movecursor(term.t_nrow - 1, 0);
X TTkclose();
X system(line);
X TTkopen();
X /* if we are interactive, pause here */
X if (clexec == FALSE) {
X mlputs("\r\n\n[End]");
X tgetc();
X }
X sgarbf = TRUE;
X return (TRUE);
X#endif
X#if V7 | USG | BSD
X if ((s=mlreply("!", line, NLINE)) != TRUE)
X return (s);
X TTputc('\n'); /* Already have '\r' */
X TTflush();
X TTclose(); /* stty to old modes */
X system(line);
X TTopen();
X mlputs("[End]"); /* Pause. */
X TTflush();
X while ((s = tgetc()) != '\r' && s != ' ')
X ;
X sgarbf = TRUE;
X return (TRUE);
X#endif
X}
X
X/*
X * Pipe a one line command into a window
X * Bound to ^X @
X */
Xpipecmd(f, n)
X{
X register int s; /* return status from CLI */
X register WINDOW *wp; /* pointer to new window */
X register BUFFER *bp; /* pointer to buffer to zot */
X char line[NLINE]; /* command line send to shell */
X static char bname[] = "command";
X
X#if AMIGA
X static char filnam[] = "ram:command";
X long newcli;
X#else
X static char filnam[] = "command";
X#endif
X
X#if MSDOS
X char *tmp;
X char *getenv();
X FILE *fp;
X FILE *fopen();
X#endif
X
X /* don't allow this command if restricted */
X if (restflag)
X return(resterr());
X
X#if MSDOS
X if ((tmp = getenv("TMP")) == NULL)
X strcpy(filnam, "command");
X else
X strcpy(filnam, tmp);
X#endif
X
X#if VMS
X mlwrite("Not availible under VMS");
X return(FALSE);
X#endif
X#if CPM
X mlwrite("Not availible under CP/M-86");
X return(FALSE);
X#endif
X
X /* get the command to pipe in */
X if ((s=mlreply("@", line, NLINE)) != TRUE)
X return(s);
X
X /* get rid of the command output buffer if it exists */
X if ((bp=bfind(bname, FALSE, 0)) != FALSE) {
X /* try to make sure we are off screen */
X wp = wheadp;
X while (wp != NULL) {
X if (wp->w_bufp == bp) {
X onlywind(FALSE, 1);
X break;
X }
X wp = wp->w_wndp;
X }
X if (zotbuf(bp) != TRUE)
X
X return(FALSE);
X }
X
X#if AMIGA
X newcli = Open("CON:0/0/639/199/MicroEmacs Subprocess", NEW);
X strcat(line, " >");
X strcat(line, filnam);
X Execute(line,0,newcli);
X s = TRUE;
X Close(newcli);
X sgarbf = TRUE;
X#endif
X#if MSDOS
X strcat(line," >>");
X strcat(line,filnam);
X movecursor(term.t_nrow - 1, 0);
X TTkclose();
X system(line);
X TTkopen();
X sgarbf = TRUE;
X if ((fp = fopen(filnam, "r")) == NULL) {
X s = FALSE;
X } else {
X fclose(fp);
X s = TRUE;
X }
X#endif
X#if V7 | USG | BSD
X TTputc('\n'); /* Already have '\r' */
X TTflush();
X TTclose(); /* stty to old modes */
X strcat(line,">");
X strcat(line,filnam);
X system(line);
X TTopen();
X TTflush();
X sgarbf = TRUE;
X s = TRUE;
X#endif
X
X if (s != TRUE)
X return(s);
X
X /* split the current window to make room for the command output */
X if (splitwind(FALSE, 1) == FALSE)
X return(FALSE);
X
X /* and read the stuff in */
X if (getfile(filnam, FALSE) == FALSE)
X return(FALSE);
X
X /* make this window in VIEW mode, update all mode lines */
X curwp->w_bufp->b_mode |= MDVIEW;
X wp = wheadp;
X while (wp != NULL) {
X wp->w_flag |= WFMODE;
X wp = wp->w_wndp;
X }
X
X /* and get rid of the temporary file */
X unlink(filnam);
X return(TRUE);
X}
X
X/*
X * filter a buffer through an external DOS program
X * Bound to ^X #
X */
Xfilter(f, n)
X
X{
X register int s; /* return status from CLI */
X register BUFFER *bp; /* pointer to buffer to zot */
X char line[NLINE]; /* command line send to shell */
X char tmpnam[NFILEN]; /* place to store real file name */
X static char bname1[] = "fltinp";
X
X#if AMIGA
X static char filnam1[] = "ram:fltinp";
X static char filnam2[] = "ram:fltout";
X long newcli;
X#else
X static char filnam1[] = "fltinp";
X static char filnam2[] = "fltout";
X#endif
X
X /* don't allow this command if restricted */
X if (restflag)
X return(resterr());
X
X if (curbp->b_mode&MDVIEW) /* don't allow this command if */
X return(rdonly()); /* we are in read only mode */
X
X#if VMS
X mlwrite("Not availible under VMS");
X return(FALSE);
X#endif
X#if CPM
X mlwrite("Not availible under CP/M-86");
X return(FALSE);
X#endif
X
X /* get the filter name and its args */
X if ((s=mlreply("#", line, NLINE)) != TRUE)
X return(s);
X
X /* setup the proper file names */
X bp = curbp;
X strcpy(tmpnam, bp->b_fname); /* save the original name */
X strcpy(bp->b_fname, bname1); /* set it to our new one */
X
X /* write it out, checking for errors */
X if (writeout(filnam1) != TRUE) {
X mlwrite("[Cannot write filter file]");
X strcpy(bp->b_fname, tmpnam);
X return(FALSE);
X }
X
X#if AMIGA
X newcli = Open("CON:0/0/639/199/MicroEmacs Subprocess", NEW);
X strcat(line, " <ram:fltinp >ram:fltout");
X Execute(line,0,newcli);
X s = TRUE;
X Close(newcli);
X sgarbf = TRUE;
X#endif
X#if MSDOS
X strcat(line," <fltinp >fltout");
X movecursor(term.t_nrow - 1, 0);
X TTkclose();
X system(line);
X TTkopen();
X sgarbf = TRUE;
X s = TRUE;
X#endif
X#if V7 | USG | BSD
X TTputc('\n'); /* Already have '\r' */
X TTflush();
X TTclose(); /* stty to old modes */
X strcat(line," <fltinp >fltout");
X system(line);
X TTopen();
X TTflush();
X sgarbf = TRUE;
X s = TRUE;
X#endif
X
X /* on failure, escape gracefully */
X if (s != TRUE || (readin(filnam2,FALSE) == FALSE)) {
X mlwrite("[Execution failed]");
X strcpy(bp->b_fname, tmpnam);
X unlink(filnam1);
X unlink(filnam2);
X return(s);
X }
X
X /* reset file name */
X strcpy(bp->b_fname, tmpnam); /* restore name */
X bp->b_flag |= BFCHG; /* flag it as changed */
X
X /* and get rid of the temporary file */
X unlink(filnam1);
X unlink(filnam2);
X return(TRUE);
X}
X
X#if VMS
X/*
X * Run a command. The "cmd" is a pointer to a command string, or NULL if you
X * want to run a copy of DCL in the subjob (this is how the standard routine
X * LIB$SPAWN works. You have to do wierd stuff with the terminal on the way in
X * and the way out, because DCL does not want the channel to be in raw mode.
X */
Xsys(cmd)
Xregister char *cmd;
X{
X struct dsc$descriptor cdsc;
X struct dsc$descriptor *cdscp;
X long status;
X long substatus;
X long iosb[2];
X
X status = SYS$QIOW(EFN, iochan, IO$_SETMODE, iosb, 0, 0,
X oldmode, sizeof(oldmode), 0, 0, 0, 0);
X if (status!=SS$_NORMAL || (iosb[0]&0xFFFF)!=SS$_NORMAL)
X return (FALSE);
X cdscp = NULL; /* Assume DCL. */
X if (cmd != NULL) { /* Build descriptor. */
X cdsc.dsc$a_pointer = cmd;
X cdsc.dsc$w_length = strlen(cmd);
X cdsc.dsc$b_dtype = DSC$K_DTYPE_T;
X cdsc.dsc$b_class = DSC$K_CLASS_S;
X cdscp = &cdsc;
X }
X status = LIB$SPAWN(cdscp, 0, 0, 0, 0, 0, &substatus, 0, 0, 0);
X if (status != SS$_NORMAL)
X substatus = status;
X status = SYS$QIOW(EFN, iochan, IO$_SETMODE, iosb, 0, 0,
X newmode, sizeof(newmode), 0, 0, 0, 0);
X if (status!=SS$_NORMAL || (iosb[0]&0xFFFF)!=SS$_NORMAL)
X return (FALSE);
X if ((substatus&STS$M_SUCCESS) == 0) /* Command failed. */
X return (FALSE);
X return (TRUE);
X}
X#endif
X
X#if ~AZTEC & MSDOS
X
X/*
X * This routine, once again by Bob McNamara, is a C translation of the "system"
X * routine in the MWC-86 run time library. It differs from the "system" routine
X * in that it does not unconditionally append the string ".exe" to the end of
X * the command name. We needed to do this because we want to be able to spawn
X * off "command.com". We really do not understand what it does, but if you don't
X * do it exactly "malloc" starts doing very very strange things.
X */
Xsys(cmd, tail)
Xchar *cmd;
Xchar *tail;
X{
X#if MWC_86
X register unsigned n;
X extern char *__end;
X
X n = __end + 15;
X n >>= 4;
X n = ((n + dsreg() + 16) & 0xFFF0) + 16;
X return(execall(cmd, tail, n));
X#endif
X
X#if LATTICE
X return(forklp(cmd, tail, (char *)NULL));
X#endif
X
X#if MSC
X return(spawnlp(P_WAIT, cmd, tail, NULL));
X#endif
X}
X#endif
X
X#if MSDOS & LATTICE
X/* System: a modified version of lattice's system() function
X that detects the proper switchar and uses it
X written by Dana Hogget */
X
Xsystem(cmd)
X
Xchar *cmd; /* Incoming command line to execute */
X
X{
X char *getenv();
X static char *swchar = "/C"; /* Execution switch */
X union REGS inregs; /* parameters for dos call */
X union REGS outregs; /* Return results from dos call */
X char *shell; /* Name of system command processor */
X char *p; /* Temporary pointer */
X int ferr; /* Error condition if any */
X
X /* get name of system shell */
X if ((shell = getenv("COMSPEC")) == NULL) {
X return (-1); /* No shell located */
X }
X
X p = cmd;
X while (isspace(*p)) { /* find out if null command */
X p++;
X }
X
X /** If the command line is not empty, bring up the shell **/
X /** and execute the command. Otherwise, bring up the **/
X /** shell in interactive mode. **/
X
X if (p && *p) {
X /** detect current switch character and us it **/
X inregs.h.ah = 0x37; /* get setting data */
X inregs.h.al = 0x00; /* get switch character */
X intdos(&inregs, &outregs);
X *swchar = outregs.h.dl;
X ferr = forkl(shell, "command", swchar, cmd, (char *)NULL);
X } else {
X ferr = forkl(shell, "command", (char *)NULL);
X }
X
X return (ferr ? ferr : wait());
X}
X#endif
E!O!F
newsize=`wc -c < spawn.c`
if [ $newsize -ne 16513 ]
then echo "File spawn.c was $newsize bytes, 16513 expected"
fi
bill davidsen (wedu@ge-crd.arpa)
{chinet | philabs | sesimo}!steinmetz!crdos1!davidsen
"Stupidity, like virtue, is its own reward" ilre