v06i080: MicroEmacs, Version 3.7 (uEmacs3.7), Part10/12
sources-request at mirror.UUCP
sources-request at mirror.UUCP
Thu Jul 31 23:54:01 AEST 1986
Submitted by: ihnp4!pur-ee!pur-phy!duncan!lawrence
Mod.sources: Volume 6, Issue 80
Archive-name: uEmacs3.7/Part10
[ This is the latest revision of one of two programs named "MicroEmacs";
when discussing these on the net, or in contacting the authors, make
sure to mention the version number -- in this case 3.7 -- as that is
the easiest way to distinguish between them. Daniel will be posting
uuencoded executables in net.micro.pc and net.micro.amiga; the file
'readme' contains information on how to also get these from him
directly. --r$ ]
echo extracting - region.c
sed 's/^X//' > region.c << 'FRIDAY_NIGHT'
X/*
X * The routines in this file
X * deal with the region, that magic space
X * between "." and mark. Some functions are
X * commands. Some functions are just for
X * internal use.
X */
X#include <stdio.h>
X#include "estruct.h"
X#include "edef.h"
X
X/*
X * Kill the region. Ask "getregion"
X * to figure out the bounds of the region.
X * Move "." to the start, and kill the characters.
X * Bound to "C-W".
X */
Xkillregion(f, n)
X{
X register int s;
X REGION region;
X
X if (curbp->b_mode&MDVIEW) /* don't allow this command if */
X return(rdonly()); /* we are in read only mode */
X if ((s=getregion(®ion)) != TRUE)
X return (s);
X if ((lastflag&CFKILL) == 0) /* This is a kill type */
X kdelete(); /* command, so do magic */
X thisflag |= CFKILL; /* kill buffer stuff. */
X curwp->w_dotp = region.r_linep;
X curwp->w_doto = region.r_offset;
X return (ldelete(region.r_size, TRUE));
X}
X
X/*
X * Copy all of the characters in the
X * region to the kill buffer. Don't move dot
X * at all. This is a bit like a kill region followed
X * by a yank. Bound to "M-W".
X */
Xcopyregion(f, n)
X{
X register LINE *linep;
X register int loffs;
X register int s;
X REGION region;
X
X if ((s=getregion(®ion)) != TRUE)
X return (s);
X if ((lastflag&CFKILL) == 0) /* Kill type command. */
X kdelete();
X thisflag |= CFKILL;
X linep = region.r_linep; /* Current line. */
X loffs = region.r_offset; /* Current offset. */
X while (region.r_size--) {
X if (loffs == llength(linep)) { /* End of line. */
X if ((s=kinsert('\n')) != TRUE)
X return (s);
X linep = lforw(linep);
X loffs = 0;
X } else { /* Middle of line. */
X if ((s=kinsert(lgetc(linep, loffs))) != TRUE)
X return (s);
X ++loffs;
X }
X }
X return (TRUE);
X}
X
X/*
X * Lower case region. Zap all of the upper
X * case characters in the region to lower case. Use
X * the region code to set the limits. Scan the buffer,
X * doing the changes. Call "lchange" to ensure that
X * redisplay is done in all buffers. Bound to
X * "C-X C-L".
X */
Xlowerregion(f, n)
X{
X register LINE *linep;
X register int loffs;
X register int c;
X register int s;
X REGION region;
X
X if (curbp->b_mode&MDVIEW) /* don't allow this command if */
X return(rdonly()); /* we are in read only mode */
X if ((s=getregion(®ion)) != TRUE)
X return (s);
X lchange(WFHARD);
X linep = region.r_linep;
X loffs = region.r_offset;
X while (region.r_size--) {
X if (loffs == llength(linep)) {
X linep = lforw(linep);
X loffs = 0;
X } else {
X c = lgetc(linep, loffs);
X if (c>='A' && c<='Z')
X lputc(linep, loffs, c+'a'-'A');
X ++loffs;
X }
X }
X return (TRUE);
X}
X
X/*
X * Upper case region. Zap all of the lower
X * case characters in the region to upper case. Use
X * the region code to set the limits. Scan the buffer,
X * doing the changes. Call "lchange" to ensure that
X * redisplay is done in all buffers. Bound to
X * "C-X C-L".
X */
Xupperregion(f, n)
X{
X register LINE *linep;
X register int loffs;
X register int c;
X register int s;
X REGION region;
X
X if (curbp->b_mode&MDVIEW) /* don't allow this command if */
X return(rdonly()); /* we are in read only mode */
X if ((s=getregion(®ion)) != TRUE)
X return (s);
X lchange(WFHARD);
X linep = region.r_linep;
X loffs = region.r_offset;
X while (region.r_size--) {
X if (loffs == llength(linep)) {
X linep = lforw(linep);
X loffs = 0;
X } else {
X c = lgetc(linep, loffs);
X if (c>='a' && c<='z')
X lputc(linep, loffs, c-'a'+'A');
X ++loffs;
X }
X }
X return (TRUE);
X}
X
X/*
X * This routine figures out the
X * bounds of the region in the current window, and
X * fills in the fields of the "REGION" structure pointed
X * to by "rp". Because the dot and mark are usually very
X * close together, we scan outward from dot looking for
X * mark. This should save time. Return a standard code.
X * Callers of this routine should be prepared to get
X * an "ABORT" status; we might make this have the
X * conform thing later.
X */
Xgetregion(rp)
Xregister REGION *rp;
X{
X register LINE *flp;
X register LINE *blp;
X long fsize;
X long bsize;
X
X if (curwp->w_markp == NULL) {
X mlwrite("No mark set in this window");
X return (FALSE);
X }
X if (curwp->w_dotp == curwp->w_markp) {
X rp->r_linep = curwp->w_dotp;
X if (curwp->w_doto < curwp->w_marko) {
X rp->r_offset = curwp->w_doto;
X rp->r_size = (long)(curwp->w_marko-curwp->w_doto);
X } else {
X rp->r_offset = curwp->w_marko;
X rp->r_size = (long)(curwp->w_doto-curwp->w_marko);
X }
X return (TRUE);
X }
X blp = curwp->w_dotp;
X bsize = (long)curwp->w_doto;
X flp = curwp->w_dotp;
X fsize = (long)(llength(flp)-curwp->w_doto+1);
X while (flp!=curbp->b_linep || lback(blp)!=curbp->b_linep) {
X if (flp != curbp->b_linep) {
X flp = lforw(flp);
X if (flp == curwp->w_markp) {
X rp->r_linep = curwp->w_dotp;
X rp->r_offset = curwp->w_doto;
X rp->r_size = fsize+curwp->w_marko;
X return (TRUE);
X }
X fsize += llength(flp)+1;
X }
X if (lback(blp) != curbp->b_linep) {
X blp = lback(blp);
X bsize += llength(blp)+1;
X if (blp == curwp->w_markp) {
X rp->r_linep = blp;
X rp->r_offset = curwp->w_marko;
X rp->r_size = bsize - curwp->w_marko;
X return (TRUE);
X }
X }
X }
X mlwrite("Bug: lost mark");
X return (FALSE);
X}
FRIDAY_NIGHT
echo extracting - search.c
sed 's/^X//' > search.c << 'FRIDAY_NIGHT'
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 */
X
X#include <stdio.h>
X#include "estruct.h"
X#include "edef.h"
X
X/*
X * Search forward. Get a search string from the user, and search, beginning at
X * ".", for the string. If found, reset the "." to be just after the match
X * string, and [perhaps] repaint the display. Bound to "C-S".
X */
X
X/* string search input parameters */
X
X#define PTBEG 1 /* leave the point at the begining on search */
X#define PTEND 2 /* leave the point at the end on search */
X
Xforwsearch(f, n)
X
X{
X register int status;
X
X /* resolve the repeat count */
X if (n == 0)
X n = 1;
X if (n < 1) /* search backwards */
X return(backsearch(f, -n));
X
X /* ask the user for the text of a pattern */
X if ((status = readpattern("Search")) != TRUE)
X return(status);
X
X /* search for the pattern */
X while (n-- > 0) {
X if ((status = forscan(&pat[0],PTEND)) == FALSE)
X break;
X }
X
X /* and complain if not there */
X if (status == FALSE)
X mlwrite("Not found");
X return(status);
X}
X
Xforwhunt(f, n)
X
X{
X register int status;
X
X /* resolve the repeat count */
X if (n == 0)
X n = 1;
X if (n < 1) /* search backwards */
X return(backhunt(f, -n));
X
X /* Make sure a pattern exists */
X if (pat[0] == 0) {
X mlwrite("No pattern set");
X return(FALSE);
X }
X
X /* search for the pattern */
X while (n-- > 0) {
X if ((status = forscan(&pat[0],PTEND)) == FALSE)
X break;
X }
X
X /* and complain if not there */
X if (status == FALSE)
X mlwrite("Not found");
X return(status);
X}
X
X/*
X * Reverse search. Get a search string from the user, and search, starting at
X * "." and proceeding toward the front of the buffer. If found "." is left
X * pointing at the first character of the pattern [the last character that was
X * matched]. Bound to "C-R".
X */
Xbacksearch(f, n)
X
X{
X register int s;
X
X /* resolve null and negative arguments */
X if (n == 0)
X n = 1;
X if (n < 1)
X return(forwsearch(f, -n));
X
X /* get a pattern to search */
X if ((s = readpattern("Reverse search")) != TRUE)
X return(s);
X
X /* and go search for it */
X bsearch(f,n);
X return(TRUE);
X}
X
Xbackhunt(f, n) /* hunt backward for the last search string entered */
X
X{
X /* resolve null and negative arguments */
X if (n == 0)
X n = 1;
X if (n < 1)
X return(forwhunt(f, -n));
X
X /* Make sure a pattern exists */
X if (pat[0] == 0) {
X mlwrite("No pattern set");
X return(FALSE);
X }
X
X /* and go search for it */
X bsearch(f,n);
X return(TRUE);
X}
X
Xbsearch(f, n)
X
X{
X register LINE *clp;
X register int cbo;
X register LINE *tlp;
X register int tbo;
X register int c;
X register char *epp;
X register char *pp;
X
X /* find a pointer to the end of the pattern */
X for (epp = &pat[0]; epp[1] != 0; ++epp)
X ;
X
X /* make local copies of the starting location */
X clp = curwp->w_dotp;
X cbo = curwp->w_doto;
X
X while (n-- > 0) {
X for (;;) {
X /* if we are at the begining of the line, wrap back around */
X if (cbo == 0) {
X clp = lback(clp);
X
X if (clp == curbp->b_linep) {
X mlwrite("Not found");
X return(FALSE);
X }
X
X cbo = llength(clp)+1;
X }
X
X /* fake the <NL> at the end of a line */
X if (--cbo == llength(clp))
X c = '\n';
X else
X c = lgetc(clp, cbo);
X
X /* check for a match against the end of the pattern */
X if (eq(c, *epp) != FALSE) {
X tlp = clp;
X tbo = cbo;
X pp = epp;
X
X /* scanning backwards through the rest of the
X pattern looking for a match */
X while (pp != &pat[0]) {
X /* wrap across a line break */
X if (tbo == 0) {
X tlp = lback(tlp);
X if (tlp == curbp->b_linep)
X goto fail;
X
X tbo = llength(tlp)+1;
X }
X
X /* fake the <NL> */
X if (--tbo == llength(tlp))
X c = '\n';
X else
X c = lgetc(tlp, tbo);
X
X if (eq(c, *--pp) == FALSE)
X goto fail;
X }
X
X /* A Match! reset the current cursor */
X curwp->w_dotp = tlp;
X curwp->w_doto = tbo;
X curwp->w_flag |= WFMOVE;
X goto next;
X }
Xfail:;
X }
Xnext:;
X }
X return(TRUE);
X}
X
X/*
X * Compare two characters. The "bc" comes from the buffer. It has it's case
X * folded out. The "pc" is from the pattern.
X */
Xeq(bc, pc)
X int bc;
X int pc;
X
X{
X if ((curwp->w_bufp->b_mode & MDEXACT) == 0) {
X if (bc>='a' && bc<='z')
X bc -= 0x20;
X
X if (pc>='a' && pc<='z')
X pc -= 0x20;
X }
X
X if (bc == pc)
X return(TRUE);
X
X return(FALSE);
X}
X
X/*
X * Read a pattern. Stash it in the external variable "pat". The "pat" is not
X * updated if the user types in an empty line. If the user typed an empty line,
X * and there is no old pattern, it is an error. Display the old pattern, in the
X * style of Jeff Lomicka. There is some do-it-yourself control expansion.
X * change to using <ESC> to delemit the end-of-pattern to allow <NL>s in
X * the search string.
X */
Xreadpattern(prompt)
X
Xchar *prompt;
X
X{
X register int s;
X char tpat[NPAT+20];
X
X strcpy(tpat, prompt); /* copy prompt to output string */
X strcat(tpat, " ["); /* build new prompt string */
X expandp(&pat[0], &tpat[strlen(tpat)], NPAT/2); /* add old pattern */
X strcat(tpat, "]<ESC>: ");
X
X s = mlreplyt(tpat, tpat, NPAT, 27); /* Read pattern */
X
X if (s == TRUE) /* Specified */
X strcpy(pat, tpat);
X else if (s == FALSE && pat[0] != 0) /* CR, but old one */
X s = TRUE;
X
X return(s);
X}
X
Xsreplace(f, n) /* Search and replace (ESC-R) */
X
Xint f; /* default flag */
Xint n; /* # of repetitions wanted */
X
X{
X return(replaces(FALSE, f, n));
X}
X
Xqreplace(f, n) /* search and replace with query (ESC-CTRL-R) */
X
Xint f; /* default flag */
Xint n; /* # of repetitions wanted */
X
X{
X return(replaces(TRUE, f, n));
X}
X
X/* replaces: search for a string and replace it with another
X string. query might be enabled (according to
X kind). */
Xreplaces(kind, f, n)
X
Xint kind; /* Query enabled flag */
Xint f; /* default flag */
Xint n; /* # of repetitions wanted */
X
X{
X register int i; /* loop index */
X register int s; /* success flag on pattern inputs */
X register int slength,
X rlength; /* length of search and replace strings */
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 tmpc; /* temporary character */
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 repititions */
X if (f && n < 0)
X return(FALSE);
X
X /* ask the user for the text of a pattern */
X if ((s = readpattern(
X (kind == FALSE ? "Replace" : "Query replace"))) != TRUE)
X return(s);
X strcpy(&tpat[0], &pat[0]); /* salt it away */
X
X /* ask for the replacement string */
X strcpy(&pat[0], &rpat[0]); /* set up default string */
X if ((s = readpattern("with")) == ABORT)
X return(s);
X
X /* move everything to the right place and length them */
X strcpy(&rpat[0], &pat[0]);
X strcpy(&pat[0], &tpat[0]);
X slength = strlen(&pat[0]);
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 nlflag = (pat[slength - 1] == '\n');
X nlrepl = FALSE;
X
X if (kind) {
X /* build query replace question string */
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 lastline = NULL;
X lastoff = 0;
X }
X
X /* save original . position */
X origline = curwp->w_dotp;
X origoff = curwp->w_doto;
X
X /* scan through the file */
X numsub = 0;
X nummatch = 0;
X while ((f == FALSE || n > nummatch) &&
X (nlflag == FALSE || nlrepl == FALSE)) {
X
X /* search for the pattern */
X if (forscan(&pat[0],PTBEG) != TRUE)
X break; /* all done */
X ++nummatch; /* increment # of matches */
X
X /* check if we are on the last line */
X nlrepl = (lforw(curwp->w_dotp) == curwp->w_bufp->b_linep);
X
X /* check for query */
X if (kind) {
X /* get the query */
Xpprompt: mlwrite(&tpat[0], &pat[0], &rpat[0]);
Xqprompt:
X update(FALSE); /* show the proposed place to change */
X c = (*term.t_getchar)(); /* and input */
X mlwrite(""); /* and clear it */
X
X /* and respond appropriately */
X switch (c) {
X case 'y': /* yes, substitute */
X case ' ':
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 if (lastline == NULL) {
X /* there is nothing to undo */
X (*term.t_beep)();
X goto qprompt;
X }
X curwp->w_dotp = lastline;
X curwp->w_doto = lastoff;
X lastline = NULL;
X lastoff = 0;
X
X /* delete the new string */
X backchar(FALSE, rlength);
X if (ldelete((long)rlength, FALSE) != TRUE) {
X mlwrite("ERROR while deleting");
X return(FALSE);
X }
X
X /* and put in the old one */
X for (i=0; i<slength; i++) {
X tmpc = pat[i];
X s = (tmpc == '\n' ? lnewline() :
X linsert(1, tmpc));
X if (s != TRUE) {
X /* error while inserting */
X mlwrite("Out of memory while inserting");
X return(FALSE);
X }
X }
X
X --numsub; /* one less substitutions */
X
X /* backup, and reprompt */
X backchar(FALSE, slength);
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 (*term.t_beep)();
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 }
X }
X
X /* delete the sucker */
X if (ldelete((long)slength, FALSE) != TRUE) {
X /* error while deleting */
X mlwrite("ERROR while deleteing");
X return(FALSE);
X }
X
X /* and insert its replacement */
X for (i=0; i<rlength; i++) {
X tmpc = rpat[i];
X s = (tmpc == '\n' ? lnewline() : linsert(1, tmpc));
X if (s != TRUE) {
X /* error while inserting */
X mlwrite("Out of memory while inserting");
X return(FALSE);
X }
X }
X
X /* save where we are if we might undo this... */
X if (kind) {
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 mlwrite("%d substitutions",numsub);
X return(TRUE);
X}
X
Xforscan(patrn,leavep) /* search forward for a <patrn> */
X
Xchar *patrn; /* string to scan for */
Xint leavep; /* place to leave point
X PTBEG = begining of match
X PTEND = at end of match */
X
X{
X register LINE *curline; /* current line during scan */
X register int curoff; /* position within current line */
X register LINE *lastline; /* last line position during scan */
X register int lastoff; /* position within last line */
X register int c; /* character at current position */
X register LINE *matchline; /* current line during matching */
X register int matchoff; /* position in matching line */
X register char *patptr; /* pointer into pattern */
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 (curline != curbp->b_linep) {
X
X /* save the current position in case we need to
X restore it on a match */
X
X lastline = curline;
X lastoff = curoff;
X
X /* get the current character resolving EOLs */
X
X if (curoff == llength(curline)) { /* if at EOL */
X curline = lforw(curline); /* skip to next line */
X curoff = 0;
X c = '\n'; /* and return a <NL> */
X } else
X c = lgetc(curline, curoff++); /* get the char */
X
X /* test it against first char in pattern */
X if (eq(c, patrn[0]) != FALSE) { /* if we find it..*/
X /* setup match pointers */
X matchline = curline;
X matchoff = curoff;
X patptr = &patrn[0];
X
X /* scan through patrn for a match */
X while (*++patptr != 0) {
X /* advance all the pointers */
X if (matchoff == llength(matchline)) {
X /* advance past EOL */
X matchline = lforw(matchline);
X matchoff = 0;
X c = '\n';
X } else
X c = lgetc(matchline, matchoff++);
X
X /* and test it against the pattern */
X if (eq(*patptr, c) == FALSE)
X goto fail;
X }
X
X /* A SUCCESSFULL MATCH!!! */
X /* reset the global "." pointers */
X if (leavep == PTEND) { /* at end of string */
X curwp->w_dotp = matchline;
X curwp->w_doto = matchoff;
X } else { /* at begining of string */
X curwp->w_dotp = lastline;
X curwp->w_doto = lastoff;
X }
X curwp->w_flag |= WFMOVE; /* flag that we have moved */
X return(TRUE);
X
X }
Xfail:; /* continue to search */
X }
X
X /* we could not find a match */
X
X return(FALSE);
X}
X
X/* expandp: expand control key sequences for output */
X
Xexpandp(srcstr, deststr, maxlength)
X
Xchar *srcstr; /* string to expand */
Xchar *deststr; /* destination of expanded string */
Xint maxlength; /* maximum chars in destination */
X
X{
X char c; /* current char to translate */
X
X /* scan through the string */
X while ((c = *srcstr++) != 0) {
X if (c == '\n') { /* its an EOL */
X *deststr++ = '<';
X *deststr++ = 'N';
X *deststr++ = 'L';
X *deststr++ = '>';
X maxlength -= 4;
X } else if (c < 0x20 || c == 0x7f) { /* control character */
X *deststr++ = '^';
X *deststr++ = c ^ 0x40;
X maxlength -= 2;
X } else if (c == '%') {
X *deststr++ = '%';
X *deststr++ = '%';
X maxlength -= 2;
X
X } else { /* any other character */
X *deststr++ = c;
X maxlength--;
X }
X
X /* check for maxlength */
X if (maxlength < 4) {
X *deststr++ = '$';
X *deststr = '\0';
X return(FALSE);
X }
X }
X *deststr = '\0';
X return(TRUE);
X}
FRIDAY_NIGHT
echo extracting - spawn.c
sed 's/^X//' > spawn.c << 'FRIDAY_NIGHT'
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 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 newcli = Open("CON:1/1/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 V7 | USG | BSD
X register char *cp;
X char *getenv();
X#endif
X#if VMS
X movecursor(term.t_nrow, 0); /* In last line. */
X mlputs("[Starting DCL]\r\n");
X (*term.t_flush)(); /* 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 MSDOS & AZTEC
X movecursor(term.t_nrow, 0); /* Seek to last line. */
X (*term.t_flush)();
X (*term.t_close)();
X system("command.com");
X (*term.t_open)();
X sgarbf = TRUE;
X return(TRUE);
X#endif
X#if MSDOS & LATTICE
X movecursor(term.t_nrow, 0); /* Seek to last line. */
X (*term.t_flush)();
X (*term.t_close)();
X sys("\\command.com", ""); /* Run CLI. */
X (*term.t_open)();
X sgarbf = TRUE;
X return(TRUE);
X#endif
X#if V7 | USG | BSD
X movecursor(term.t_nrow, 0); /* Seek to last line. */
X (*term.t_flush)();
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#if AMIGA
X long newcli;
X
X if ((s=mlreply("!", line, NLINE)) != TRUE)
X return (s);
X newcli = Open("CON:1/1/639/199/MicroEmacs Subprocess", NEW);
X Execute(line,0,newcli);
X Close(newcli);
X (*term.t_getchar)(); /* Pause. */
X sgarbf = TRUE;
X return(TRUE);
X#endif
X#if VMS
X if ((s=mlreply("!", line, NLINE)) != TRUE)
X return (s);
X (*term.t_putchar)('\n'); /* Already have '\r' */
X (*term.t_flush)();
X s = sys(line); /* Run the command. */
X mlputs("\r\n\n[End]"); /* Pause. */
X (*term.t_flush)();
X (*term.t_getchar)();
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
X if ((s=mlreply("!", line, NLINE)) != TRUE)
X return(s);
X movecursor(term.t_nrow - 1, 0);
X (*term.t_close)();
X system(line);
X (*term.t_open)();
X mlputs("\r\n\n[End]"); /* Pause. */
X (*term.t_getchar)(); /* Pause. */
X sgarbf = TRUE;
X return (TRUE);
X#endif
X#if V7 | USG | BSD
X if ((s=mlreply("!", line, NLINE)) != TRUE)
X return (s);
X (*term.t_putchar)('\n'); /* Already have '\r' */
X (*term.t_flush)();
X ttclose(); /* stty to old modes */
X system(line);
X ttopen();
X mlputs("[End]"); /* Pause. */
X (*term.t_flush)();
X while ((s = (*term.t_getchar)()) != '\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 */
Xpipe(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 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 return(FALSE);
X }
X
X#if AMIGA
X newcli = Open("CON:1/1/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 (*term.t_close)();
X system(line);
X (*term.t_open)();
X sgarbf = TRUE;
X s = TRUE;
X#endif
X#if V7 | USG | BSD
X (*term.t_putchar)('\n'); /* Already have '\r' */
X (*term.t_flush)();
X ttclose(); /* stty to old modes */
X strcat(line,">");
X strcat(line,filnam);
X system(line);
X ttopen();
X (*term.t_flush)();
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#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:1/1/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 (*term.t_close)();
X system(line);
X (*term.t_open)();
X sgarbf = TRUE;
X s = TRUE;
X#endif
X#if V7 | USG | BSD
X (*term.t_putchar)('\n'); /* Already have '\r' */
X (*term.t_flush)();
X ttclose(); /* stty to old modes */
X strcat(line," <fltinp >fltout");
X system(line);
X ttopen();
X (*term.t_flush)();
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
X
FRIDAY_NIGHT
echo es.10 completed!
: That's all folks!
More information about the Mod.sources
mailing list