Usenet 1994 January

home *** CD-ROM | disk | FTP | other *** search

/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume1 / 8711 / microemacs-3.9 / 11 < prev next >

Wrap

Text File | 1987-11-20 | 35.9 KB | 1,500 lines

Article 88 of comp.sources.misc: Path: tut!osu-cis!cbosgd!mandrill!hal!ncoast!allbery From: nwd@j.cc.purdue.edu (Daniel Lawrence) Newsgroups: comp.sources.misc Subject: MicroEmacs 3.9 (Part 11 of 16) Message-ID: <5687@ncoast.UUCP> Date: 17 Nov 87 02:34:04 GMT Sender: allbery@ncoast.UUCP Lines: 1485 Approved: allbery@ncoast.UUCP X-Archive: comp.sources.misc/microemacs-3.9/10 # This is a shar archive. # Remove everything above this line. # Run the file through sh, not csh. # (type `sh mes.11') # If you do not see the message # `mes.11 completed!' # then the file was incomplete. 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 1006L 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 | TURBO) X#include <process.h> 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 mlwrite("[Starting new CLI]"); X sgarbf = TRUE; X Execute("NEWCLI \"CON:0/0/640/200/MicroEMACS Subprocess\"", 0L, 0L); 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 MSDOS & (AZTEC | MSC | TURBO) X movecursor(term.t_nrow, 0); /* Seek to last line. */ X TTflush(); X TTkclose(); X shellprog(""); X TTkopen(); X sgarbf = TRUE; X return(TRUE); X#endif X#if ST520 & MWC X mlerase(); /* clear the message line */ X TTflush(); X TTkclose(); X system("msh.prg"); 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 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/640/200/MicroEMACS Subprocess", NEW); X Execute(line, 0L, newcli); X Close(newcli); X tgetc(); /* Pause. */ X sgarbf = TRUE; X return(TRUE); X#endif X 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 X if ((s=mlreply("!", line, NLINE)) != TRUE) X return(s); X movecursor(term.t_nrow - 1, 0); X TTkclose(); X shellprog(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 ST520 & MWC X if ((s=mlreply("!", line, NLINE)) != TRUE) X return(s); X mlerase(); 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 * Run an external program with arguments. When it 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 */ X Xexecprg(f, n) X X{ X register int s; X char line[NLINE]; 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/640/200/MicroEMACS Subprocess", NEW); X Execute(line, 0L, newcli); X Close(newcli); X tgetc(); /* Pause. */ X sgarbf = TRUE; X return(TRUE); X#endif X 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 X if ((s=mlreply("$", line, NLINE)) != TRUE) X return(s); X movecursor(term.t_nrow - 1, 0); X TTkclose(); X execprog(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 ST520 & MWC X if ((s=mlreply("!", line, NLINE)) != TRUE) X return(s); X mlerase(); 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[NSTRING] = "command"; X#endif X X#if MSDOS | (ST520 & MWC) 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 strcat(filnam,"\\command"); X } 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/640/200/MicroEMACS Subprocess", NEW); X strcat(line, " >"); X strcat(line, filnam); X Execute(line, 0L, newcli); X s = TRUE; X Close(newcli); X sgarbf = TRUE; X#endif X#if MSDOS | (ST520 & MWC) X strcat(line," >>"); X strcat(line,filnam); X movecursor(term.t_nrow - 1, 0); X TTkclose(); X#if MSDOS X shellprog(line); X#else X system(line); X#endif 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/640/200/MicroEMACS Subprocess", NEW); X strcat(line, " <ram:fltinp >ram:fltout"); X Execute(line,0L,newcli); X s = TRUE; X Close(newcli); X sgarbf = TRUE; X#endif X#if MSDOS | (ST520 & MWC) X strcat(line," <fltinp >fltout"); X movecursor(term.t_nrow - 1, 0); X TTkclose(); X#if MSDOS X shellprog(line); X#else X system(line); X#endif 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 & ~MSC & ~TURBO & 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 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#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 X#if MSDOS & LATTICE Xextern int _oserr; X#endif X X#if MSDOS & AZTEC Xextern int errno; X#endif X X#if MSDOS & (TURBO | LATTICE | AZTEC) X/* SHELLPROG: Execute a command in a subshell */ X Xshellprog(cmd) X Xchar *cmd; /* Incoming command line to execute */ X X{ X char *shell; /* Name of system command processor */ X char *p; /* Temporary pointer */ X char swchar; /* switch character to use */ X union REGS regs; /* parameters for dos call */ X char comline[NSTRING]; /* constructed command line */ X char *getenv(); X X /* detect current switch character and set us up to use it */ X regs.h.ah = 0x37; /* get setting data */ X regs.h.al = 0x00; /* get switch character */ X intdos(®s, ®s); X swchar = (char)regs.h.dl; X X /* get name of system shell */ X if ((shell = getenv("COMSPEC")) == NULL) { X return(FALSE); /* No shell located */ X } X X /* trim leading whitespace off the command */ X while (*cmd == ' ' || *cmd == '\t') /* find out if null command */ X cmd++; 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 (*cmd) { X strcpy(comline, shell); X strcat(comline, " "); X comline[strlen(comline) + 1] = 0; X comline[strlen(comline)] = swchar; X strcat(comline, "c "); X strcat(comline, cmd); X return(execprog(comline)); X } else X return(execprog(shell)); X} X X/* EXECPROG: A function to execute a named program X with arguments X*/ X Xexecprog(cmd) X Xchar *cmd; /* Incoming command line to execute */ X X{ X char *sp; /* temporary string pointer */ X char f1[38]; /* FCB1 area (not initialized */ X char f2[38]; /* FCB2 area (not initialized */ X char prog[NSTRING]; /* program filespec */ X char tail[NSTRING]; /* command tail with length byte */ X union REGS regs; /* parameters for dos call */ X struct SREGS segreg; /* segment registers for dis call */ X struct pblock { /* EXEC parameter block */ X short envptr; /* 2 byte pointer to environment string */ X char *cline; /* 4 byte pointer to command line */ X char *fcb1; /* 4 byte pointer to FCB at PSP+5Ch */ X char *fcb2; /* 4 byte pointer to FCB at PSP+6Ch */ X } pblock; X char *flook(); X X /* parse the command name from the command line */ X sp = prog; X while (*cmd && (*cmd != ' ') && (*cmd != '\t')) X *sp++ = *cmd++; X *sp = 0; X X /* and parse out the command tail */ X while (*cmd && ((*cmd == ' ') || (*cmd == '\t'))) X ++cmd; X *tail = (char)(strlen(cmd)); /* record the byte length */ X strcpy(&tail[1], cmd); X strcat(&tail[1], "\r"); X X /* look up the program on the path trying various extentions */ X if ((sp = flook(prog, TRUE)) == NULL) X if ((sp = flook(strcat(prog, ".exe"), TRUE)) == NULL) { X strcpy(&prog[strlen(prog)-4], ".com"); X if ((sp = flook(prog, TRUE)) == NULL) X return(FALSE); X } X strcpy(prog, sp); X X /* get a pointer to this PSPs environment segment number */ X segread(&segreg); X X /* set up the EXEC parameter block */ X pblock.envptr = 0; /* make the child inherit the parents env */ X pblock.fcb1 = f1; /* point to a blank FCB */ X pblock.fcb2 = f2; /* point to a blank FCB */ X pblock.cline = tail; /* parameter line pointer */ X X /* and make the call */ X regs.h.ah = 0x4b; /* EXEC Load or Execute a Program */ X regs.h.al = 0x00; /* load end execute function subcode */ X#if AZTEC X regs.x.ds = ((unsigned long)(prog) >> 16); /* program name ptr */ X#else X segreg.ds = ((unsigned long)(prog) >> 16); /* program name ptr */ X#endif X regs.x.dx = (unsigned int)(prog); X#if AZTEC X regs.x.es = regs.x.ds; X /*regs.x.es = ((unsigned long)(&pblock) >> 16); * set up param block ptr */ X#else X segreg.es = ((unsigned long)(&pblock) >> 16); /* set up param block ptr */ X#endif X regs.x.bx = (unsigned int)(&pblock); X#if LATTICE X#define CFLAG 1 X if ((intdosx(®s, ®s, &segreg) & CFLAG) == 0) { X regs.h.ah = 0x4d; /* get child process return code */ X intdos(®s, ®s); /* go do it */ X rval = regs.x.ax; /* save child's return code */ X } else X rval = -_oserr; /* failed child call */ X#endif X#if AZTEC X#define CFLAG 1 X if ((sysint(0x21, ®s, ®s) & CFLAG) == 0) { X regs.h.ah = 0x4d; /* get child process return code */ X sysint(0x21, ®s, ®s); /* go do it */ X rval = regs.x.ax; /* save child's return code */ X } else X rval = -errno; /* failed child call */ X#endif X#if TURBO X intdosx(®s, ®s, &segreg); X if (regs.x.cflag == 0) { X regs.h.ah = 0x4d; /* get child process return code */ X intdos(®s, ®s); /* go do it */ X rval = regs.x.ax; /* save child's return code */ X } else X rval = -_doserrno; /* failed child call */ X#endif X return((rval < 0) ? FALSE : TRUE); X} X#endif FRIDAY_NIGHT echo extracting - st520.c sed 's/^X//' > st520.c << 'FRIDAY_NIGHT' X/* X XThe routines in this file provide support for the Atari 520 or 1040ST Xusing VT52 emulation. The I/O services are provided here as well. It Xcompiles into nothing if not a 520ST style device. The only compiler Xsupported directly is Mark Williams C X XAdditional code and ideas from: X X James Turner X Jeff Lomicka X J. C. Benoist X X*/ X X#define termdef 1 /* don't define "term" external */ X X#include <stdio.h> X#include "estruct.h" X#include "edef.h" X X#if ATARI & ST520 X X/* X These routines provide support for the ATARI 1040ST and 520ST Xusing the virtual VT52 Emulator X X*/ X X#include <osbind.h> X#include <aline.h> X#include <linea.h> X X#define NROW 50 /* Screen size. */ X#define NCOL 80 /* Edit if you want to. */ X#define MARGIN 8 /* size of minimim margin and */ X#define SCRSIZ 64 /* scroll size for extended lines */ X#define NPAUSE 300 /* # times thru update to pause */ X#define BIAS 0x20 /* Origin 0 coordinate bias. */ X#define ESC 0x1B /* ESC character. */ X#define SCRFONT 2 /* index of 8x16 monochrome system default font */ X#define DENSIZE 50 /* # of lines in a dense screen */ X X/**** ST Internals definitions *****/ X X/* BIOS calls */ X X#define BCONSTAT 1 /* return input device status */ X#define CONIN 2 /* read character from device */ X#define BCONOUT 3 /* write character to device */ X X/* XBIOS calls */ X X#define INITMOUS 0 /* initialize the mouse */ X#define GETREZ 4 /* get current resolution */ X#define SETSCREEN 5 /* set screen resolution */ X#define SETPALETTE 6 /* set the color pallette */ X#define SETCOLOR 7 /* set or read a color */ X#define CURSCONF 21 /* set cursor configuration */ X#define IKBDWS 25 /* intelligent keyboard send command */ X#define KBDVBASE 34 /* get keyboard table base */ X X/* GEMDOS calls */ X X#define EXEC 0x4b /* Exec off a process */ X X#define CON 2 /* CON: Keyboard and screen device */ X X/* Palette color definitions */ X X#define LOWPAL "000700070770007707077777" X#define MEDPAL "000700007777" X#define HIGHPAL "111000" X X/* ST Global definitions */ X X/* keyboard vector table */ Xstruct KVT { X long midivec; /* midi input */ X long vkbderr; /* keyboard error */ X long vmiderr; /* MIDI error */ X long statvec; /* IKBD status */ X int (*mousevec)(); /* mouse vector */ X long clockvec; /* clock vector */ X long joyvec; /* joystict vector */ X} *ktable; X Xint (*sysmint)(); /* system mouse interupt handler */ X X/* mouse parameter table */ Xstruct Param { X char topmode; X char buttons; X char xparam; X char yparam; X int xmax,ymax; X int xinitial,yinitial; X} mparam; X Xint initrez; /* initial screen resolution */ Xint currez; /* current screen resolution */ Xchar resname[][8] = { /* screen resolution names */ X "LOW", "MEDIUM", "HIGH", "DENSE" X}; Xshort spalette[16]; /* original color palette settings */ Xshort palette[16]; /* current palette settings */ X XLINEA *aline; /* Pointer to line a parameter block returned by init */ X XNLINEA *naline; /* Pointer to line a parameters at negative offsets */ X XFONT **fonts; /* Array of pointers to the three system font headers */ X /* returned by init (in register A1) */ X XWORD (**foncs)(); /* Array of pointers to the 15 line a functions */ X /* returned by init (in register A2) */ X /* only valid in ROM'ed TOS */ X XFONT *system_font; /* pointer to default system font */ XFONT *small_font; /* pointer to small font */ X Xextern int ttopen(); /* Forward references. */ Xextern int ttgetc(); Xextern int ttputc(); Xextern int ttflush(); Xextern int ttclose(); Xextern int stmove(); Xextern int steeol(); Xextern int steeop(); Xextern int stbeep(); Xextern int stopen(); Xextern int stclose(); Xextern int stgetc(); Xextern int stputc(); Xextern int strev(); Xextern int strez(); Xextern int stkopen(); Xextern int stkclose(); X X#if COLOR Xextern int stfcol(); Xextern int stbcol(); X#endif X X/* X * Dispatch table. All the X * hard fields just point into the X * terminal I/O code. X */ XTERM term = { X NROW-1, X NROW-1, X NCOL, X NCOL, X MARGIN, X SCRSIZ, X NPAUSE, X &stopen, X &stclose, X &stkopen, X &stkclose, X &stgetc, X &stputc, X &ttflush, X &stmove, X &steeol, X &steeop, X &stbeep, X &strev, X &strez X#if COLOR X , &stfcol, X &stbcol X#endif X}; X Xvoid init_aline() X{ X linea0(); X aline = (LINEA *)(la_init.li_a0); X fonts = (FONT **)(la_init.li_a1); X foncs = la_init.li_a2; X naline = ((NLINEA *)aline) - 1; X} X Xinit() X{ X init_aline(); X system_font = fonts[SCRFONT]; /* save it */ X small_font = fonts[1]; X} X X Xswitch_font(fp) X XFONT *fp; X X{ X /* See aline.h for description of fields */ X /* these definitions are temporary...too many cooks!!! */ X#undef V_CEL_HT X#undef V_CEL_WR X#undef V_CEL_MY X#undef V_CEL_MX X#undef V_FNT_ST X#undef V_FNT_ND X#undef V_FNT_AD X#undef V_FNT_WR X#undef V_OFF_AD X#undef VWRAP X#undef V_Y_MAX X#undef V_X_MAX X X naline->V_CEL_HT = fp->form_height; X naline->V_CEL_WR = aline->VWRAP * fp->form_height; X naline->V_CEL_MY = (naline->V_Y_MAX / fp->form_height) - 1; X naline->V_CEL_MX = (naline->V_X_MAX / fp->max_cell_width) - 1; X naline->V_FNT_WR = fp->form_width; X naline->V_FNT_ST = fp->first_ade; X naline->V_FNT_ND = fp->last_ade; X naline->V_OFF_AD = fp->off_table; X naline->V_FNT_AD = fp->dat_table; X} X Xstmove(row, col) X{ X stputc(ESC); X stputc('Y'); X stputc(row+BIAS); X stputc(col+BIAS); X} X Xsteeol() X{ X stputc(ESC); X stputc('K'); X} X Xsteeop() X{ X#if COLOR X stfcol(gfcolor); X stbcol(gbcolor); X#endif X stputc(ESC); X stputc('J'); X} X Xstrev(status) /* set the reverse video state */ X Xint status; /* TRUE = reverse video, FALSE = normal video */ X X{ X if (currez > 1) { X stputc(ESC); X stputc(status ? 'p' : 'q'); X } X} X X#if COLOR Xmapcol(clr) /* medium rez color translation */ X Xint clr; /* emacs color number to translate */ X X{ X static int mctable[] = {0, 1, 2, 3, 2, 1, 2, 3}; X X if (currez != 1) X return(clr); X else X return(mctable[clr]); X} X Xstfcol(color) /* set the forground color */ X Xint color; /* color to set forground to */ X X{ X if (currez < 2) { X stputc(ESC); X stputc('b'); X stputc(mapcol(color)); X } X} X Xstbcol(color) /* set the background color */ X Xint color; /* color to set background to */ X X X{ X if (currez < 2) { X stputc(ESC); X stputc('c'); X stputc(mapcol(color)); X } X} X#endif X Xstatic char beep[] = { X 0x00, 0x00, X 0x01, 0x01, X 0x02, 0x01, X 0x03, 0x01, X 0x04, 0x02, X 0x05, 0x01, X 0x07, 0x38, X 0x08, 0x10, X 0x09, 0x10, X 0x0A, 0x10, X 0x0B, 0x00, X 0x0C, 0x30, X 0x0D, 0x03, X 0xFF, 0x00 X}; X Xstbeep() X{ X Dosound(beep); X} X Xdomouse() /* mouse interupt handler */ X X{ X return((*sysmint)()); X} X Xstkopen() /* open the keyboard (and mouse) */ X X{ X /* grab the keyboard vector table */ X ktable = (struct KVT *)xbios(KBDVBASE); X sysmint = ktable->mousevec; /* save mouse vector */ X X /* initialize the mouse */ X mparam.topmode = 0; X mparam.buttons = 4; X mparam.xparam = 8; X mparam.yparam = 10; X mparam.xmax = 79; X mparam.ymax = 23; X mparam.xinitial = 0; X mparam.yinitial = 0; X xbios(INITMOUS, 4, &mparam, &domouse); X} X Xstopen() /* open the screen */ X X{ X int i; X X ttopen(); X eolexist = TRUE; X init(); X X /* switch to a steady cursor */ X xbios(CURSCONF, 3); X X /* save the current color palette */ X for (i=0; i<16; i++) X spalette[i] = xbios(SETCOLOR, i, -1); X X /* and find the current resolution */ X initrez = currez = xbios(GETREZ); X strcpy(sres, resname[currez]); X X /* set up the screen size and palette */ X switch (currez) { X case 0: term.t_mrow = 25 - 1; X term.t_nrow = 25 - 1; X term.t_ncol = 40; X strcpy(palstr, LOWPAL); X break; X X case 1: term.t_mrow = 25 - 1; X term.t_nrow = 25 - 1; X strcpy(palstr, MEDPAL); X break; X X case 2: term.t_mrow = DENSIZE - 1; X term.t_nrow = 25 - 1; X strcpy(palstr, HIGHPAL); X } X X /* and set up the default palette */ X spal(palstr); X X stputc(ESC); /* automatic overflow off */ X stputc('w'); X stputc(ESC); /* turn cursor on */ X stputc('e'); X} X Xstkclose() /* close the keyboard (and mouse) */ X X{ X static char resetcmd[] = {0x80, 0x01}; /* keyboard reset command */ X X /* restore the mouse interupt routines */ X xbios(INITMOUS, 2, &mparam, (long)sysmint); X X /* and reset the keyboard controller */ X xbios(IKBDWS, 1, &resetcmd[0]); X} X Xstclose() X X{ X stputc(ESC); /* auto overflow on */ X stputc('v'); X X /* switch to a flashing cursor */ X xbios(CURSCONF, 2); X X /* restore the original screen resolution */ X if (currez == 3) X switch_font(system_font); X strez(resname[initrez]); X X /* restore the original palette settings */ X xbios(SETPALETTE, spalette); X X ttclose(); X} X X/* spal(pstr): reset the current palette according to a X "palette string" of the form X X 000111222333444555666777 X X which contains the octal values for the palette registers X*/ X Xspal(pstr) X Xchar *pstr; /* palette string */ X X{ X int pal; /* current palette position */ X int clr; /* current color value */ X int i; X X for (pal = 0; pal < 16; pal++) { X if (*pstr== 0) X break; X X /* parse off a color */ X clr = 0; X for (i = 0; i < 3; i++) X if (*pstr) X clr = clr * 16 + (*pstr++ - '0'); X palette[pal] = clr; X }; X X /* and now set it */ X xbios(SETPALETTE, palette); X} X Xstgetc() /* get a char from the keyboard */ X X{ X register long rval; /* return value from BIOS call */ X static int funkey = 0; /* held fuction key scan code */ X static long sh; /* shift/alt key on held function? */ X long bios(); X X /* if there is a pending function key, return it */ X if (funkey) { X if (sh) { /* alt or cntrl */ X if (funkey >= 0x3B && funkey <= 0x44) { X rval = funkey + '^' - ';'; X if (sh & 0x08) /* alt */ X rval += 10; X funkey = 0; X return(rval & 255); X } X } X rval = funkey; X funkey = 0; X } else { X /* waiting... flash the cursor */ X xbios(CURSCONF, 2); X X /* get the character */ X rval = bios(CONIN, CON); X sh = Getshift(-1) & 0x0cL; /* see if alt or cntrl depressed */ X if ((rval & 255L) == 0L) { X funkey = (rval >> 16L) & 255; X rval = 0; X } X X } X X /* and switch to a steady cursor */ X xbios(CURSCONF, 3); X X return(rval & 255); X} X Xstputc(c) /* output char c to the screen */ X Xchar c; /* character to print out */ X X{ X bios(BCONOUT, CON, c); X} X Xstrez(newrez) /* change screen resolution */ X Xchar *newrez; /* requested resolution */ X X{ X int nrez; /* requested new resolution */ X X /* first, decode the resolution name */ X for (nrez = 0; nrez < 4; nrez++) X if (strcmp(newrez, resname[nrez]) == 0) X break; X if (nrez == 4) { X mlwrite("%%No such resolution"); X return(FALSE); X } X X /* next, make sure this resolution is legal for this monitor */ X if ((currez < 2 && nrez > 1) || (currez > 1 && nrez < 2)) { X mlwrite("%%Resolution illegal for this monitor"); X return(FALSE); X } X X /* eliminate non-changes */ X if (currez == nrez) X return(TRUE); X X /* finally, make the change */ X switch (nrez) { X case 0: /* low resolution - 16 colors */ X newwidth(TRUE, 40); X strcpy(palstr, LOWPAL); X xbios(SETSCREEN, -1L, -1L, 0); X break; X X case 1: /* medium resolution - 4 colors */ X newwidth(TRUE, 80); X strcpy(palstr, MEDPAL); X xbios(SETSCREEN, -1L, -1L, 1); X break; X X case 2: /* High resolution - 2 colors - 25 lines */ X newsize(TRUE, 25); X strcpy(palstr, HIGHPAL); X switch_font(system_font); X break; X X case 3: /* Dense resolution - 2 colors - 40 lines */ X newsize(TRUE, DENSIZE); X strcpy(palstr, HIGHPAL); X switch_font(small_font); X break; X } X X /* and set up the default palette */ X spal(palstr); X currez = nrez; X strcpy(sres, resname[currez]); X X stputc(ESC); /* automatic overflow off */ X stputc('w'); X stputc(ESC); /* turn cursor on */ X stputc('e'); X X return(TRUE); X} X X#if LATTICE Xsystem(cmd) /* call the system to execute a new program */ X Xchar *cmd; /* command to execute */ X X{ X char *pptr; /* pointer into program name */ X char pname[NSTRING]; /* name of program to execute */ X char tail[NSTRING]; /* command tail */ X X /* scan off program name.... */ X pptr = pname; X while (*cmd && (*cmd != ' ' && *cmd != '\t')) X *pptr++ = *cmd++; X *pptr = 0; X X /* create program name length/string */ X tail[0] = strlen(cmd); X strcpy(&tail[1], cmd); X X /* go do it! */ X return(gemdos( (int)EXEC, X (int)0, X (char *)pname, X (char *)tail, X (char *)NULL)); X} X#endif X X#if TYPEAH Xtypahead() X X{ X int rval; /* return value from BIOS call */ X X /* get the status of the console */ X rval = bios(BCONSTAT, CON); X X /* end return the results */ X if (rval == 0) X return(FALSE); X else X return(TRUE); X} X#endif X X#if FLABEL Xfnclabel(f, n) /* label a function key */ X Xint f,n; /* default flag, numeric argument [unused] */ X X{ X /* on machines with no function keys...don't bother */ X return(TRUE); X} X#endif X#else Xsthello() X{ X} X#endif FRIDAY_NIGHT echo mes.11 completed! # That's all folks!