home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / EDITOR / MG2A_SRC.ZIP / SYS / VMS / SPAWN.C < prev    next >
Encoding:
C/C++ Source or Header  |  1988-08-23  |  8.9 KB  |  334 lines
  1. /*
  2.  * Name:    MicroEMACS
  3.  *        VAX/VMS spawn and attach to a DCL subprocess.
  4.  * Created:    rex::conroy
  5.  *        decvax!decwrl!dec-rhea!dec-rex!conroy
  6.  * Modified:
  7.  *         19-May-86 ...!ihnp4!seismo!ut-sally!ut-ngp!mic
  8.  *            Add att-to-parent command to attach to the parent
  9.  *            process.  If we can't attach to parent somehow,
  10.  *            spawn a DCL subjob.  This gives us the same
  11.  *            suspend capability as Unix Emacses.
  12.  *
  13.  *            As an added hook, you can DEFINE/JOB
  14.  *            MG$ATTACHTO to a process name, and
  15.  *            the code will try to attach to that name.
  16.  *
  17.  *            Also, if the logical name MG$FILE is
  18.  *            defined, attachtoparent() will visit that file
  19.  *            when you re-attach to Emacs.  This is useful
  20.  *            for a lot of applications, especially MAIL/EDIT...
  21.  *        26-Jun-86 ...!ihnp4!seismo!ut-sally!ut-ngp!mic
  22.  *            Specify process we're attaching to when we attempt
  23.  *            to attach to it.
  24.  *        03-Sep-86 ...!ihnp4!seismo!ut-sally!ut-ngp!mic
  25.  *            Call savebuffers() before leaving the editor.
  26.  *            Unlike csh, DCL has no problem with people
  27.  *            logging out without completing subjobs...
  28.  *            #define NOSAVEONZ if you don't want this behavior.
  29.  *        13-Oct-86 ...!ihnp4!seismo!ut-sally!ut-ngp!mic
  30.  *            Change MICROEMACS$... to MG$... for consistency.
  31.  *        20-Feb-87 ...!ihnp4!seismo!ut-sally!ut-ngp!mic
  32.  *            Get rid of call to eputs(), so it can be private
  33.  *            to echo.c.
  34.  */
  35. #include    "def.h"
  36.  
  37. #include    <ssdef.h>
  38. #include    <stsdef.h>
  39. #include    <descrip.h>
  40. #include    <iodef.h>
  41. #include    <jpidef.h>
  42.  
  43. #define    EFN    0                /* Event flag.        */
  44.  
  45. extern    int    oldmode[3];            /* In "ttyio.c".    */
  46. extern    int    newmode[3];
  47. extern    short    iochan;
  48. extern    int    ckttysize();            /* Checks for new term size */
  49. extern    int    savebuffers();            /* Save all buffers before  */
  50.  
  51. /*
  52.  * Create a subjob with a copy
  53.  * of the command intrepreter in it. When the
  54.  * command interpreter exits, mark the screen as
  55.  * garbage so that you do a full repaint. Bound
  56.  * to "C-C" and called from "C-Z". The message at
  57.  * the start in VMS puts out a newline. Under
  58.  * some (unknown) condition, you don't get one
  59.  * free when DCL starts up.
  60.  */
  61.  
  62. spawncli(f, n)
  63. {
  64.     register int    s;
  65.     register char    *msg;
  66.  
  67.     if (savebuffers() == ABORT)        /* TRUE means all saved,*/
  68.         return (ABORT);            /* FALSE means not.    */
  69.     eerase();                /* Get rid of echo line    */
  70.     ttcolor(CTEXT);                /* Normal color.    */
  71.     ttnowindow();                /* Full screen scroll.    */
  72.     ttmove(nrow-1, 0);            /* Last line.        */
  73.     msg = "Starting DCL";
  74.     while (*msg)                /* Avoid using eputs()    */
  75.         ttputc(*(msg++));
  76.     ttputc('\r');
  77.     ttputc('\n');
  78.     ttflush();
  79.     sgarbf = TRUE;
  80.     s = sys(NULL);                /* NULL => DCL.        */
  81.     return (s);
  82. }
  83.  
  84. /*
  85.  * Run a command. The "cmd" is a pointer
  86.  * to a command string, or NULL if you want to run
  87.  * a copy of DCL in the subjob (this is how the standard
  88.  * routine LIB$SPAWN works. You have to do wierd stuff
  89.  * with the terminal on the way in and the way out,
  90.  * because DCL does not want the channel to be
  91.  * in raw mode.
  92.  */
  93. sys(cmd)
  94. register char    *cmd;
  95. {
  96.     struct    dsc$descriptor    cdsc;
  97.     struct    dsc$descriptor    *cdscp;
  98.     long    status;
  99.     long    substatus;
  100.     long    iosb[2];
  101.  
  102.     status = SYS$QIOW(EFN, iochan, IO$_SETMODE, iosb, 0, 0,
  103.               oldmode, sizeof(oldmode), 0, 0, 0, 0);
  104.     if (status!=SS$_NORMAL || (iosb[0]&0xFFFF)!=SS$_NORMAL)
  105.         return (FALSE);
  106.     cdscp = NULL;                /* Assume DCL.        */
  107.     if (cmd != NULL) {            /* Build descriptor.    */
  108.         cdsc.dsc$a_pointer = cmd;
  109.         cdsc.dsc$w_length  = strlen(cmd);
  110.         cdsc.dsc$b_dtype   = DSC$K_DTYPE_T;
  111.         cdsc.dsc$b_class   = DSC$K_CLASS_S;
  112.         cdscp = &cdsc;
  113.     }
  114.     status = LIB$SPAWN(cdscp, 0, 0, 0, 0, 0, &substatus, 0, 0, 0);
  115.     if (status != SS$_NORMAL)
  116.         substatus = status;
  117.     ckttysize();            /* check for new terminal size */
  118.     status = SYS$QIOW(EFN, iochan, IO$_SETMODE, iosb, 0, 0,
  119.               newmode, sizeof(newmode), 0, 0, 0, 0);
  120.     if (status!=SS$_NORMAL || (iosb[0]&0xFFFF)!=SS$_NORMAL)
  121.         return (FALSE);
  122.     if ((substatus&STS$M_SUCCESS) == 0)    /* Command failed.    */
  123.         return (FALSE);
  124.     return (TRUE);
  125. }
  126.  
  127. /*
  128.  * Front end for combined attach-to-parent and spawn-cli action
  129.  */
  130.  
  131. attachtoparent(f, n)
  132. {
  133.     register int    s;
  134.     s = attparent();
  135.     if (s == ABORT)
  136.         return (ABORT);
  137.     else if (s == FALSE)
  138.         return spawncli(f, n);    /* better than nothing */
  139.     else
  140.         return (TRUE);
  141. }
  142.  
  143. /*
  144.  * Attach to parent.  If the logical name MG$ATTACHTO
  145.  * is present, attempt to attach to it.  If not, attempt to
  146.  * attach to parent process.
  147.  *
  148.  * On return, see if the logical name MG$FILE contains
  149.  * anything, and try to visit that file.
  150.  */
  151.  
  152. static $DESCRIPTOR(nmdsc,"MG$ATTACHTO");
  153.  
  154. attparent()
  155. {
  156.     long        pid, jpi_code;    
  157.     char        equiv[18], msgbuf[60];
  158.     struct    dsc$descriptor_s eqdsc;
  159.     short        eqlen;
  160.     int        status, pos;
  161.     register BUFFER    *bp;
  162.     BUFFER        *findbuffer();
  163.     int        s;
  164.  
  165.  
  166.     /* Set up string descriptor */
  167.     eqdsc.dsc$a_pointer = equiv;
  168.     eqdsc.dsc$w_length  = sizeof(equiv);
  169.     eqdsc.dsc$b_dtype   = DSC$K_DTYPE_T;
  170.     eqdsc.dsc$b_class   = DSC$K_CLASS_S;
  171.  
  172.     /* Try to translate MG$ATTACH */
  173.     status = lib$sys_trnlog(&nmdsc, &eqdsc.dsc$w_length, &eqdsc);
  174.     if (status!=SS$_NORMAL && status!=SS$_NOTRAN) {
  175.         ewprintf("Error translating %s",nmdsc.dsc$a_pointer);/* DEBUG */
  176.         return (FALSE);
  177.     }
  178.  
  179.     if (status == SS$_NORMAL) {
  180.         /* Found a translation -- attempt to attach to it */
  181.         jpi_code = JPI$_PID;
  182.  
  183.         status = lib$getjpi(&jpi_code,0,&eqdsc,&pid,0);
  184.         equiv[eqdsc.dsc$w_length] = '\0';
  185.         if (status != SS$_NORMAL) {
  186.             ewprintf("Error getting JPI for \"%s\"",equiv);
  187.             return (FALSE);
  188.         }
  189.  
  190.         /* Attempt to attach to named process.  Save all buffers,  */
  191.         /* set sgarbf because attach() always trashes the display  */
  192.         if (savebuffers() == ABORT)
  193.             return (ABORT);
  194.         /* indicate process we're attaching to */
  195.         strcpy(msgbuf,"Attaching to process \"");
  196.         for (pos = strlen(equiv) - 1; pos >= 0; --pos)
  197.             if (equiv[pos] != ' ') {
  198.                 equiv[pos+1] = '\0';
  199.                 break;
  200.             }
  201.         strcat(msgbuf,equiv);
  202.         strcat(msgbuf,"\"");
  203.  
  204.         sgarbf = TRUE;
  205.         if (attach(pid,msgbuf) == FALSE)    /* whups -- try spawn */
  206.             return (FALSE);
  207.     }
  208.     else {    /* No translation -- attempt to find parent process */
  209.         jpi_code = JPI$_OWNER;
  210.         status = lib$getjpi(&jpi_code,0,0,&pid,0,0);
  211.  
  212.         if ((status != SS$_NORMAL) || (pid == 0))    /* not found! */
  213.             return (FALSE);
  214.  
  215.         if (savebuffers() == ABORT)
  216.             return (ABORT);
  217.         sgarbf = TRUE;
  218.         if (attach(pid,"Attaching to parent process") == FALSE)
  219.             return (FALSE);
  220.     }
  221.  
  222.     newfile();    /* attempt to find a new file, but don't care    */
  223.             /* if we don't find one...            */
  224.     refresh(FFRAND, 0);
  225.     return (TRUE);
  226. }
  227.  
  228. /*
  229.  * If we find after re-attaching that there is
  230.  * a new file to be edited, attempt to read it in,
  231.  * using essentially the same code as findfile().
  232.  */
  233.  
  234. static newfile()
  235. {
  236.     register BUFFER    *bp;
  237.     register int    s;
  238.     char        filename[NFILEN];
  239.     BUFFER        *findbuffer();
  240.  
  241.     if ((s = cknewfile(filename, sizeof filename)) != TRUE)
  242.         return (s);
  243.     if ((bp = findbuffer(filename, &s)) == NULL)
  244.         return (s);
  245.     curbp = bp;
  246.     if (showbuffer(bp, curwp, WFHARD) != TRUE)
  247.         return (FALSE);
  248.     if (bp->b_fname[0] == 0)
  249.         return (readin(filename));    /* Read it in. */
  250.     return (TRUE);
  251. }
  252.  
  253. /*
  254.  * Attach to a process by process number.  Restore the
  255.  * terminal channel to the way it was when we started.
  256.  * Also put out an optional message to the user.
  257.  */ 
  258.  
  259. static attach(pid, msg)
  260. long pid;
  261. char *msg;
  262. {
  263.     long    status, attstatus;
  264.     long    iosb[2];
  265.  
  266.     ttcolor(CTEXT);                /* Normal color.    */
  267.     ttnowindow();                /* Full screen scroll.    */
  268.     ttmove(nrow-1, 0);            /* Last line.        */
  269.     if (msg) {                /* Display a message    */
  270.         while (*msg)
  271.             ttputc(*(msg++));
  272.         ttputc('\r');
  273.         ttputc('\n');
  274.     }
  275.     ttflush();
  276.  
  277.     /* Set terminal to old modes */
  278.     status = SYS$QIOW(EFN, iochan, IO$_SETMODE, iosb, 0, 0,
  279.               oldmode, sizeof(oldmode), 0, 0, 0, 0);
  280.     if (status!=SS$_NORMAL || (iosb[0]&0xFFFF)!=SS$_NORMAL)
  281.         return (FALSE);
  282.  
  283.     /* Attach to the process */
  284.     attstatus = LIB$ATTACH(&pid);
  285.  
  286.     /* Return terminal to the modes MG needs */
  287.     ckttysize();            /* check for new terminal size first */
  288.     status = SYS$QIOW(EFN, iochan, IO$_SETMODE, iosb, 0, 0,
  289.               newmode, sizeof(newmode), 0, 0, 0, 0);
  290.     if (status!=SS$_NORMAL || (iosb[0]&0xFFFF)!=SS$_NORMAL)
  291.         return (FALSE);
  292.  
  293.     return (attstatus == SS$_NORMAL ? TRUE : FALSE);
  294. }
  295.  
  296.  
  297. /*
  298.  * Attempt to translate MG$FILE into fname.
  299.  * If it's there and non-empty, return TRUE.
  300.  */
  301.  
  302. static $DESCRIPTOR(filedsc,"MG$FILE");
  303.  
  304. static cknewfile(fname,fnsiz)
  305. char *fname;
  306. int fnsiz;
  307. {
  308.     char     equiv[NFILEN];
  309.     struct dsc$descriptor_s eqdsc;
  310.     short    len;
  311.     register int    status;
  312.  
  313.     eqdsc.dsc$a_pointer = equiv;
  314.     eqdsc.dsc$w_length  = sizeof(equiv);
  315.     eqdsc.dsc$b_dtype   = DSC$K_DTYPE_T;
  316.     eqdsc.dsc$b_class   = DSC$K_CLASS_S;
  317.  
  318.     status = lib$sys_trnlog(&filedsc, &len, &eqdsc);
  319.     if (status!=SS$_NORMAL && status!=SS$_NOTRAN) {
  320.         ewprintf("Error translating MG$FILE");
  321.         return (FALSE);
  322.     }
  323.  
  324.     if (status == SS$_NOTRAN)        /* No new file found    */
  325.         return (FALSE);
  326.  
  327.     if (equiv[0] == ' ')
  328.         return (FALSE);
  329.  
  330.     equiv[len] = '\0';
  331.     strcpy(fname, equiv);
  332.     return (TRUE);
  333. }
  334.