home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD2.mdf / c / m_emacs / ue311c / vms.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-07-13  |  37.4 KB  |  1,409 lines
  1. /*    VMS.C    Operating system specific I/O and spawning functions
  2.         For VAX/VMS operating system
  3.         for MicroEMACS 3.10
  4.         Copyright 1989 by Jeffrey A. Lomicka and Daniel M. Lawrence
  5.  
  6.     All-new code replaces the previous VMS/SMG implementation which
  7.     prevented using non-SMG terminal drivers (ansi, termcap).  New
  8.     approach to terminal I/O, new (and more) subprocess control
  9.     functions, Kept emacs support, mail/notes interface.
  10.  
  11.     Some of the above may still be wishlist.
  12.  
  13.     12-Dec-89    Kevin A. Mitchell
  14.             Start work on RMSIO code.
  15. */
  16. #include    <stdio.h>
  17. #include    "estruct.h"
  18. #if    VMS
  19. #include    "eproto.h"
  20. #include    "edef.h"
  21. #include    "elang.h"
  22.  
  23. #include ssdef
  24. #include descrip
  25. #include jpidef
  26. #include iodef
  27. #include ttdef
  28. #include tt2def
  29. #include msgdef
  30. #include string
  31. #include rms
  32. #include ctype
  33. /*
  34.     These are the LIB$SPAWN mode flags.  There's no .h for
  35.     them in VAX C V2.4.
  36. */
  37. #define CLI$M_NOCONTROL 32
  38. #define CLI$M_NOCLISYM 2
  39. #define CLI$M_NOLOGNAM 4
  40. #define CLI$M_NOKEYPAD 8
  41. #define CLI$M_NOTIFY 16
  42. #define CLI$M_NOWAIT 1
  43. /*
  44.     test macro is used to signal errors from system services
  45. */
  46. #define test( s) {int st; st = (s); if ((st&1)==0) LIB$SIGNAL( st);}
  47.  
  48. /*
  49.     This routine returns a pointer to a descriptor of the supplied
  50.     string. The descriptors are static allocated, and up to
  51.     "NUM_DESCRIPTORS" may be used at once.  After that, the old ones
  52.     are re-used. Be careful!
  53.  
  54.     The primary use of this routine is to allow passing of C strings into
  55.     VMS system facilities and RTL functions.
  56.  
  57.     There are three forms:
  58.  
  59.         descrp( s, l)    String descriptor for buffer s, length l
  60.         descptr( s)    String descriptor for asciz buffer s
  61.         DESCPTR( s)    String descriptor for buffer s, using sizeof()
  62. */
  63. #define NUM_DESCRIPTORS 10
  64. struct  dsc$descriptor_s *descrp(char *s, int l)
  65. {
  66.     static next_d = 0;
  67.     static struct dsc$descriptor_s dsclist[ NUM_DESCRIPTORS];
  68.  
  69.     if (next_d >= NUM_DESCRIPTORS) next_d = 0;
  70.     dsclist[ next_d].dsc$w_length = l;
  71.     dsclist[ next_d].dsc$b_dtype =  DSC$K_DTYPE_T;
  72.     dsclist[ next_d].dsc$b_class =  DSC$K_CLASS_S;
  73.     dsclist[ next_d].dsc$a_pointer = s;
  74.     return( &dsclist[ next_d++]);
  75. }
  76.  
  77. /*
  78.  * Make pointer to descriptor from Asciz string.
  79.  */
  80. struct dsc$descriptor_s *descptr(char *s)
  81. {
  82.     return( descrp( s, strlen( s)));
  83. }
  84.  
  85. #define DESCPTR(s)    descrp( s, sizeof(s)-1)
  86.  
  87. /*
  88.     These two structures, along with ttdef.h, are good for manipulating
  89.     terminal characteristics.
  90. */
  91. typedef struct
  92. {    /* Terminal characteristics buffer */
  93.     unsigned char class, type;
  94.     unsigned short width;
  95.     unsigned tt1 : 24;
  96.     unsigned char page;
  97.     unsigned long tt2;
  98. } TTCHAR;
  99.  
  100. typedef struct
  101. {    /* More terminal characteristics (hidden in the status block) */
  102.     short status;
  103.     char txspeed;
  104.     char rxspeed;
  105.     long trash;
  106. } TTCHARIOSB;
  107.  
  108. typedef struct
  109. {    /* Status block for ordinary terminal reads */
  110.     unsigned short status, len, term, tlen;
  111. } TTIOSB;
  112.  
  113. typedef struct
  114. {    /* Status block for mailbox reads */
  115.     unsigned short status, len; long sender_pid;
  116. } MBIOSB;
  117.  
  118. typedef struct
  119. {    /* Messages from the terminal or TW driver */
  120.     short msgtype;    /* Expecting MSG$_TRMHANGUP */
  121.     short unit;        /* Controller unit number */
  122.     char ctrl_len;    /* Length of controller name (should be 3) */
  123.     char ctrl[15];    /* Controller name (should be TWA) */
  124.     short brdcnt;    /* Broadcast message byte count, if MSG$TRMBRDCST */
  125.     char message[514];    /* First two bytes of broadcast message */
  126. } TTMESSAGE;
  127.  
  128. static readonly int noterm[] = {0,0};    /* Terminator list of NONE */
  129. static int newbrdcst = FALSE;    /* Flag - is message in Emacs buffer yet.*/
  130.  
  131. #define    MINREAD    128  /* Smallest read to queue */
  132. #define TYPSIZE 1024 /* Typeahead buffer size, must be several times MINREAD */
  133.  
  134. static unsigned char tybuf[ TYPSIZE];    /* Typeahead buffer */
  135. static unsigned tyin, tyout, tylen, tymax;/* Inptr, outptr, and length */
  136.  
  137. static TTIOSB ttiosb;        /* Terminal I/O status block */
  138. static MBIOSB mbiosb;        /* Associated mailbox status block */
  139. static TTMESSAGE mbmsg;        /* Associated mailbox message */
  140. unsigned noshare short vms_iochan;/* VMS I/O channel open on terminal */
  141. static short mbchan;        /* VMS I/O channel open on associated mbx */
  142. static short waiting;        /* Flag FALSE if read already pending */
  143. static short stalled;        /* Flag TRUE if I/O stalled by full buffer */
  144.  
  145.  
  146. /*
  147.     If we come from ME$EDIT, the "suspend-emacs" is not allowed, since
  148.     it will tend to wake itself up and re-hiberneate itself, which is
  149.     a problem.
  150. */
  151. static short called = 0;        /* TRUE if called from ME$EDIT */
  152. /*
  153.     short_time[ 0] is the negative number of 100ns units of time to
  154.     wait.  -10000 is 1ms, therefore 200ms (2 tenths of a second) is
  155.     -2,000,000.  Hopefully this is long enough for the network delay
  156.     that might be involved between seeing the ESC and seeing the
  157.     characters that follow it.
  158.  
  159.     This will be initialized from the environment variable
  160.     MICROEMACS$SHORTWAIT.
  161. */
  162. static long short_time[2] = {-4000000, -1};
  163.  
  164. static unsigned char tobuf[ TYPSIZE];    /* Output buffer */
  165. static unsigned tolen;            /* Ammount used */
  166. NOSHARE TTCHAR orgchar;            /* Original characteristics */
  167. static TTCHARIOSB orgttiosb;        /* Original IOSB characteristics */
  168.  
  169. static readast()
  170. {    /* Data arrived from the terminal */
  171.     waiting = 1;
  172.     if ((ttiosb.status == SS$_TIMEOUT) || (ttiosb.status & 1))
  173.     {    /* Read completed okay, process the data */
  174.     if (ttiosb.len)
  175.     {    /* Got some data, adjust input queue parameters */
  176.         tylen += ttiosb.len;
  177.         tyin += ttiosb.len;
  178.         test( SYS$WAKE( 0, 0));
  179.         next_read( 1);
  180.     }
  181.     else
  182.     {    /* The user seems to have stopped typing, issue a read
  183.         that will wake us up when the next character is typed */
  184.         if (!mbchan) next_read( 0);
  185.     }
  186.     }
  187.     else if (ttiosb.status != SS$_ABORT) LIB$SIGNAL( ttiosb.status);
  188. }
  189.  
  190. /*
  191.  * flag = TRUE to use timeout of 0.
  192.  */
  193. static next_read(int flag)
  194. {
  195.     if ( waiting || stalled)
  196.     {    /* No current read outstanding, submit one */
  197.     unsigned size;
  198. /*
  199.     Wrap the input pointer if out of room
  200. */
  201.     waiting = 0;
  202.     if (sizeof( tybuf) - tyin < MINREAD)
  203.     {
  204.         tymax = tyin;
  205.         tyin = 0;
  206.     }
  207.     size = tymax - tylen;
  208.     if (tyin + size > sizeof( tybuf)) size = sizeof( tybuf) - tyin;
  209.     if (size >= MINREAD)
  210.     {    /* Only read if there is enough room */
  211.         test( SYS$QIO(
  212.         0, vms_iochan,
  213.         flag ?
  214.             IO$_READVBLK | IO$M_NOECHO | IO$M_TRMNOECHO |
  215.             IO$M_NOFILTR | IO$M_TIMED
  216.         :
  217.             IO$_READVBLK | IO$M_NOECHO | IO$M_TRMNOECHO |
  218.             IO$M_NOFILTR,
  219.         &ttiosb, readast, 0, &tybuf[ tyin], flag ? size : 1,
  220.         0, noterm, 0, 0
  221.         ));
  222.         stalled = 0;
  223.     }
  224.     else stalled = 1;
  225.     }
  226. }
  227.  
  228.  
  229. /***********************************************************
  230. * FUNCTION - RemoveEscapes - remove ANSI escapes from string
  231. * (for broadcast messages that contain 'formatting')
  232. ***********************************************************/
  233. static void RemoveEscapes(char *str)
  234. {
  235.     char *in=str,*out=str;
  236.  
  237.     while (*in)
  238.     {
  239.         switch (*in)
  240.         {
  241.             case 0x1b:
  242.                 in++; /* skip escape */
  243.                 if (*in != '[') /* not a CSI */
  244.                 {
  245.                     switch (*in)
  246.                     {
  247.                         /* skip special characters */
  248.                         case ';':
  249.                         case '?':
  250.                         case '0':
  251.                             in++;
  252.                     }
  253.                     /* skip any intermediate characters 0x20 to 0x2f */
  254.                     while (*in >= 0x20 && *in <= 0x2f) in++;
  255.                     /* skip any final characters 0x30 to 0x7e */
  256.                     if (*in >= 0x30 && *in <= 0x7e) in++;
  257.             break;
  258.                 }
  259.                 /* fall through to CSI */
  260.             case 0x9b:    /* CSI */
  261.                 in++; /* skip CSI */
  262.                 /* skip any parameters 0x30 to 0x3f */
  263.                 while (*in >= 0x30 && *in <= 0x3f) in++;
  264.                 /* skip any intermediates 0x20 to 0x2f */
  265.                 while (*in >= 0x20 && *in <= 0x2f) in++;
  266.                 /* skip one final character 0x40 to 0x7e */
  267.                 if (*in >= 0x40 && *in <= 0x7e) in++;
  268.         break;
  269.             default:
  270.                 *out++ = *in++;
  271.         }
  272.     }
  273.     *out = 0;
  274. }
  275.  
  276. /*
  277.  * The argument msgbuf points to the buffer we want to
  278.  * insert our broadcast message into. Handcraft the EOL
  279.  * on the end.
  280.  */
  281. static brdaddline(BUFFER *msgbuf)
  282. {
  283.         register LINE   *lp;
  284.         register int    i;
  285.         register int    ntext;
  286.         register int    cmark;
  287.         register WINDOW *wp;
  288.  
  289.         ntext = strlen(brdcstbuf);
  290.         if ((lp=lalloc(ntext)) == NULL)
  291.                 return(FALSE);
  292.         for (i=0; i<ntext; ++i)
  293.                 lputc(lp, i, brdcstbuf[i]);
  294.         msgbuf->b_linep->l_bp->l_fp = lp;       /* Hook onto the end    */
  295.         lp->l_bp = msgbuf->b_linep->l_bp;
  296.         msgbuf->b_linep->l_bp = lp;
  297.         lp->l_fp = msgbuf->b_linep;
  298.         msgbuf->b_dotp = lp;            /* move it to new line  */
  299.  
  300.         wp = wheadp;
  301.         while (wp != NULL) {
  302.                 if (wp->w_bufp == msgbuf) {
  303.                         wp->w_dotp  = lp;
  304.                         wp->w_doto  = 0;
  305.             for (cmark = 0; cmark < NMARKS; cmark++) {
  306.                             wp->w_markp[cmark] = NULL;
  307.                             wp->w_marko[cmark] = 0;
  308.                     }
  309.                         wp->w_flag |= WFMODE|WFHARD;
  310.                 }
  311.                 wp = wp->w_wndp;
  312.         }
  313.         update(FALSE);
  314.         return(TRUE);
  315. }
  316.  
  317. static chkbrdcst()
  318. {
  319.     BUFFER *msgbuf;            /* buffer containing messages */
  320.  
  321.     if (newbrdcst)
  322.     {
  323.         int oldrow=ttrow, oldcol=ttcol;
  324.  
  325.         SYS$SETAST(0);
  326.  
  327.         msgbuf = bfind("[-messages-]", TRUE, 0);
  328.  
  329.         if (msgbuf)
  330.         {
  331.             msgbuf->b_mode |= MDVIEW;
  332.             msgbuf->b_flag |= BFINVS;
  333.             brdaddline(msgbuf);
  334.         }
  335.  
  336.     newbrdcst = FALSE;
  337.         movecursor(oldrow, oldcol);
  338.         TTmove(oldrow, oldcol);
  339.         SYS$SETAST(1);
  340.     }
  341. }
  342.  
  343. static mbreadast()
  344. {
  345.     if (mbiosb.status & 1)
  346.     {    /* Read completed okay, check for hangup message */
  347.     if (mbmsg.msgtype == MSG$_TRMHANGUP)
  348.     {
  349.         /* Got a termination message, process it */
  350.     }
  351.     else if (mbmsg.msgtype == MSG$_TRMUNSOLIC)
  352.     {    /* Got unsolicited input, get it */
  353.         next_read(1);
  354.     }
  355.     else if (mbmsg.msgtype == MSG$_TRMBRDCST)
  356.     {    /* Got broadcast, get it */
  357.         /* Hard-coding the mbmsg.brdcnt to 511 is a temp solution.*/
  358.         mbmsg.brdcnt = 511;
  359.         memcpy(brdcstbuf, mbmsg.message, 511);
  360.         brdcstbuf[511] = 0;
  361.  
  362.         RemoveEscapes(brdcstbuf);
  363.         pending_msg = newbrdcst = TRUE;
  364.     }
  365.     else
  366.     {
  367.     }
  368.     test( SYS$QIO(        /* Post a new read to the associated mailbox */
  369.         0, mbchan, IO$_READVBLK, &mbiosb,
  370.         mbreadast, 0, &mbmsg, sizeof( mbmsg),
  371.         0, 0, 0, 0
  372.         ));
  373.     }
  374.     else if (mbiosb.status != SS$_ABORT) LIB$SIGNAL( mbiosb.status);
  375. }
  376.  
  377. PASCAL NEAR ttopen()
  378. {
  379.     TTCHAR newchar;        /* Adjusted characteristics */
  380.     int status;
  381.     char *waitstr;
  382.  
  383.     tyin = 0;
  384.     tyout = 0;
  385.     tylen = 0;
  386.     tymax = sizeof( tybuf);
  387.     status = LIB$ASN_WTH_MBX(    /* Create a new PY/TW pair */
  388.     descptr( "SYS$OUTPUT:"),
  389.     &sizeof( mbmsg),
  390.     &sizeof( mbmsg),
  391.     &vms_iochan,
  392.     &mbchan);
  393.     if ((status & 1) == 0)
  394.     {    /* The assign channel failed, was it because of the mailbox? */
  395.     if (status == SS$_DEVACTIVE)
  396.     {    /* We've been called from NOTES, so we can't use the mailbox */
  397.         test( SYS$ASSIGN( descptr( "SYS$OUTPUT:"), &vms_iochan, 0, 0));
  398.         mbchan = 0;
  399.     }
  400.     else LIB$SIGNAL( status);
  401.     }
  402.     waiting = 0;        /* Block unsolicited input from issuing read */
  403.     stalled = 0;        /* Don't start stalled */
  404.     if (mbchan) test( SYS$QIO(        /* Post a read to the associated mailbox */
  405.     0, mbchan, IO$_READVBLK, &mbiosb,
  406.     mbreadast, 0, &mbmsg, sizeof( mbmsg),
  407.     0, 0, 0, 0
  408.     ));
  409. /*
  410.     Fetch the characteristics and adjust ourself for proper operation.
  411. */
  412.     test( SYS$QIOW(
  413.     0, vms_iochan, IO$_SENSEMODE, &orgttiosb,
  414.     0, 0, &orgchar, sizeof( orgchar), 0, 0, 0, 0));
  415.     newchar = orgchar;
  416.     newchar.tt2 |= TT2$M_PASTHRU;    /* Gives us back ^U, ^X, ^C, and ^Y. */
  417.     newchar.tt2 |= TT2$M_BRDCSTMBX;    /* Get broadcast messages */
  418.     newchar.tt1 &= ~TT$M_MBXDSABL;    /* Make sure mailbox is on */
  419.     newchar.tt1 |= TT$M_NOBRDCST;    /* Don't trash the screen with these */
  420.  
  421. /*
  422.     Hostsync allows super-fast typing (workstation paste, PC
  423.     send-file) without loss of data, as long as terminal supports
  424.     XON/XOFF.  VWS and DECWindows terminal emulators require HOSTSYNC
  425.     for PASTE operations to work, even though there is no wire involved.
  426. */
  427.     newchar.tt1 |= TT$M_HOSTSYNC;
  428. /*
  429.     If you MUST, and if you know you don't need XON/XOFF
  430.     synchronization, you can get ^S and ^Q back as data by defining
  431.     XONDATA in ESTRUCT.H.  This is guarnteed to fail on VT125, VT100's
  432.     over 3600 baud, any serial line terminal with smooth scroll
  433.     enabled, VT200's over 4800 baud.  This is guarnteed to WORK if you
  434.     are using a VT330/340 with SSU enabled, a VWS or DECWindows
  435.     terminal emulator.  Note that if XONDATA is not set, I trust the
  436.     settings the user has, so you just $ SET TERM /[NO]TTSYNC as you wish.
  437. */
  438. #if XONDATA
  439.     newchar.tt1 &= ~TT$M_TTSYNC;
  440. #endif
  441. /*
  442.     I checked in DISPLAY.C, and verified that the mrow and mcol
  443.     numbers aren't used until after ttopen() is called.  I override
  444.     the terminal-supplied numbers with large numbers of my own, so
  445.     that workstation terminal resizes will work to reasonable limits.
  446.  
  447.     I don't just use the current sizes as the maximum, becuase it's
  448.     possible to resize the terminal emulator after Emacs is started,
  449.     or even to disconnect and reconnect with a new terminal size, so
  450.     the maximums must not change over multiple calls to ttopen().
  451.  
  452.     Also note that I do the changes to newchar, so that the actual
  453.     terminal window will be reduced to the maximum values Microemacs
  454.     will support.
  455. */
  456.     term.t_mrow = 72;        /* 72 is European full page */
  457.     term.t_mcol = 256;        /* 256 is Wider than any termnal I've tried */
  458.     if (newchar.page > term.t_mrow) newchar.page = term.t_mrow;
  459.     term.t_nrow = newchar.page-1;
  460.     if (newchar.width > term.t_mcol) newchar.width = term.t_mcol;
  461.     term.t_ncol = newchar.width;
  462. /*
  463.     Set these new characteristics
  464. */
  465.     test( SYS$QIOW(
  466.     0, vms_iochan, IO$_SETMODE, 0,
  467.     0, 0, &newchar, sizeof( newchar), 0, 0, 0, 0));
  468. /*
  469.     For some unknown reason, if I don't post this read (which will
  470.     likely return right away) then I don't get started properly.
  471.     It has something to do with priming the unsolicited input system.
  472. */
  473.     test( SYS$QIO(
  474.     0, vms_iochan,
  475.     IO$_READVBLK | IO$M_NOECHO | IO$M_TRMNOECHO |
  476.         IO$M_NOFILTR | IO$M_TIMED,
  477.     &ttiosb, readast, 0, tybuf, sizeof( tybuf),
  478.     0, noterm, 0, 0
  479.     ));
  480. /*
  481.     Initialize the short_time value for esc-reads.  Larger values may
  482.     be needed on network links.  I'm still experimeinting to get the
  483.     best numbers.
  484. */
  485.     waitstr = getenv( "MICROEMACS$SHORTWAIT");
  486.     if (waitstr) short_time[ 0] = -asc_int( waitstr);
  487. }
  488.  
  489. PASCAL NEAR ttclose()
  490. {
  491.     if (tolen > 0)
  492.     {    /* Buffer not empty, flush out last stuff */
  493.     test( SYS$QIOW( 0, vms_iochan, IO$_WRITEVBLK  | IO$M_NOFORMAT,
  494.         0, 0, 0, tobuf, tolen, 0, 0, 0, 0));
  495.     tolen = 0;
  496.     }
  497.     test( SYS$CANCEL( vms_iochan));    /* Cancel any pending read */
  498.     test( SYS$QIOW(
  499.     0, vms_iochan,IO$_SETMODE, 0,
  500.     0, 0, &orgchar, sizeof( orgchar), 0, 0, 0, 0));
  501.     if (mbchan) test( SYS$DASSGN( mbchan));
  502.     test( SYS$DASSGN( vms_iochan));
  503. }
  504.  
  505. PASCAL NEAR ttputc(int c)
  506. {
  507.     tobuf[ tolen++] = c;
  508.     if (tolen >= sizeof( tobuf))
  509.     {    /* Buffer is full, send it out */
  510.     test( SYS$QIOW( 0, vms_iochan, IO$_WRITEVBLK | IO$M_NOFORMAT,
  511.         0, 0, 0, tobuf, tolen, 0, 0, 0, 0));
  512.     tolen = 0;
  513.     }
  514. }
  515.  
  516. PASCAL NEAR ttflush()
  517. {
  518. /*
  519.     I choose to ignore any flush requests if there is typeahead
  520.     pending.  Speeds DECNet network operation by leaps and bounds
  521.     (literally).
  522. */
  523.     if (tylen == 0) if (tolen != 0)
  524.     {    /* No typeahead, send it out */
  525.     test( SYS$QIOW( 0, vms_iochan, IO$_WRITEVBLK  | IO$M_NOFORMAT,
  526.         0, 0, 0, tobuf, tolen, 0, 0, 0, 0));
  527.     tolen = 0;
  528.     }
  529. }
  530. /*
  531.     ttgetc_shortwait is a routine that tries to read another
  532.     character, and if one doesn't come in as fast as we expect
  533.     function keys sequences to arrive, we return -1.  This is called
  534.     after receving ESC to check for next character.  It's okay to wait
  535.     too long, but the length of the delay controls how log the user
  536.     waits after hitting ESC before results are seen.
  537.  
  538.     Note that we also wake from hibernation if a character arrives, so
  539.     this never causes an undue delay if the user it actually typing.
  540. */
  541. PASCAL NEAR ttgetc_shortwait()
  542. {
  543.     if (tylen == 0)
  544.     {    /* Nothing immediately available, hibernate for a short time */
  545.     test( SYS$SCHDWK( 0, 0, short_time, 0));
  546.     test( SYS$HIBER());
  547.     }
  548.  
  549.     return ((tylen == 0)? -1: ttgetc());
  550. }
  551.  
  552. PASCAL NEAR ttgetc()
  553. {
  554.     register unsigned ret;
  555.  
  556.     chkbrdcst();
  557.     while (tylen == 0)
  558.     {    /* Nothing to send, wait for something interesting */
  559.     ttflush();
  560.     test(SYS$HIBER());
  561.     chkbrdcst();
  562.     }
  563.  
  564.     /*
  565.      * Got something, return it.
  566.      */
  567.     SYS$SETAST( 0);
  568.     ret = tybuf[ tyout++];
  569.  
  570.     if (tyout >= tymax) {
  571.         tyout = 0;
  572.         tymax = sizeof( tybuf);
  573.     }
  574.  
  575.     tylen--;        /* Should be ADD_INTERLOCKED */
  576.  
  577.     if (stalled && (tylen < 2 * MINREAD)) {
  578.     test( SYS$DCLAST( next_read, 1, 0));
  579.     }
  580.  
  581. #if 0
  582. /* This is obsolete - now pop-buffer the buffer [-messages-] to read
  583.    your messages.
  584.  */
  585.     if (newbrdcst)
  586.     {    /* New broadcast message, update broadcast variable */
  587.     VDESC vd;
  588.     findvar( "%brdcst", &vd, 0);
  589.     svar( &vd, brdcstbuf);
  590.     newbrdcst = FALSE;
  591.     }
  592. #endif
  593.     SYS$SETAST( 1);
  594.     return( ret);
  595. }
  596.  
  597. /*
  598.  * Typahead - any characters pending?
  599.  */
  600. PASCAL NEAR typahead()
  601. {
  602.     return( tylen != 0);
  603. }
  604.  
  605. /*
  606.  * Shell out to DCL.
  607.  */
  608. PASCAL NEAR spawncli(int f, int n)
  609. {
  610.     register char *cp;
  611.  
  612.     /*
  613.      * Don't allow this command if restricted
  614.      */
  615.     if (restflag) return(resterr());
  616.     movecursor(term.t_nrow, 0);            /* Seek to last line.   */
  617.     TTclose();                    /* stty to old settings */
  618.     test( LIB$SPAWN( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0));
  619.     sgarbf = TRUE;
  620.     TTopen();
  621.     return(TRUE);
  622. }
  623.  
  624. /*
  625.  * Spawn a command.
  626.  */
  627. PASCAL NEAR spawn(int f, int n)
  628. {
  629.     register int    s;
  630.     char        line[NLINE];
  631.     /*
  632.      * Don't allow this command if restricted.
  633.      */
  634.     if (restflag) return(resterr());
  635.  
  636.     if ((s=mlreply("!", line, NLINE)) != TRUE)
  637.         return(s);
  638.     TTputc('\n');        /* Already have '\r' */
  639.     TTflush();
  640.     TTclose();            /* stty to old modes */
  641.     system(line);
  642.     TTopen();
  643.     TTflush();
  644.  
  645.     /* if we are interactive, pause here */
  646.     if (clexec == FALSE) {
  647.         mlputs(TEXT6);
  648. /*               "\r\n\n[End]" */
  649.         tgetc();
  650.     }
  651.     sgarbf = TRUE;
  652.     return(TRUE);
  653. }
  654.  
  655. /*
  656.  * Run an external program with arguments. When it returns, wait for a single
  657.  * character to be typed, then mark the screen as garbage so a full repaint is
  658.  * done. Bound to "C-X $".
  659.  */
  660. PASCAL NEAR execprg(int f, int n)
  661. {
  662.         register int    s;
  663.         char            line[NLINE];
  664.  
  665.     /* Don't allow this command if restricted. */
  666.     if (restflag)
  667.         return(resterr());
  668.  
  669.         if ((s=mlreply("!", line, NLINE)) != TRUE)
  670.                 return(s);
  671.         TTputc('\n');            /* Already have '\r' */
  672.         TTflush();
  673.         TTclose();            /* stty to old modes */
  674.         system(line);
  675.         TTopen();
  676.         mlputs(TEXT188);        /* Pause. */
  677. /*             "[End]" */
  678.         TTflush();
  679.         while ((s = tgetc()) != '\r' && s != ' ')
  680.                 ;
  681.         sgarbf = TRUE;
  682.         return(TRUE);
  683. }
  684.  
  685. PASCAL NEAR pipecmd()
  686. {
  687.     register int    s;        /* return status from CLI */
  688.     register WINDOW *wp;    /* pointer to new window */
  689.     register BUFFER *bp;    /* pointer to buffer to zot */
  690.     char    line[NLINE];    /* command line send to shell */
  691.     static char bname[] = "command.log";
  692.  
  693.     static char filnam[NFILEN] = "command.log";
  694.  
  695.     /* don't allow this command if restricted */
  696.     if (restflag) return(resterr());
  697.  
  698.     /* get the command to pipe in */
  699.     if ((s=mlreply("@", line, NLINE)) != TRUE) return(s);
  700.  
  701.     /* get rid of the command output buffer if it exists */
  702.     if ((bp=bfind(bname, FALSE, 0)) != FALSE) {
  703.         /* try to make sure we are off screen */
  704.         wp = wheadp;
  705.         while (wp != NULL) {
  706.             if (wp->w_bufp == bp) {
  707.                 onlywind(FALSE, 1);
  708.                 break;
  709.             }
  710.             wp = wp->w_wndp;
  711.         }
  712.         if (zotbuf(bp) != TRUE)
  713.  
  714.             return(FALSE);
  715.     }
  716.  
  717.     TTputc('\n');        /* Already have '\r'     */
  718.     TTflush();
  719.     TTclose();            /* stty to old modes    */
  720.  
  721.     test( LIB$SPAWN( descptr( line), DESCPTR( "NL:"), descptr( filnam),
  722.     0, 0, 0, 0, 0, 0, 0, 0));
  723.     TTopen();
  724.     TTflush();
  725.     sgarbf = TRUE;
  726.     s = TRUE;
  727.  
  728.     if (s != TRUE)
  729.         return(s);
  730.  
  731.     /* split the current window to make room for the command output */
  732.     if (splitwind(FALSE, 1) == FALSE)
  733.             return(FALSE);
  734.  
  735.     /* and read the stuff in */
  736.     if (getfile(filnam, FALSE) == FALSE)
  737.         return(FALSE);
  738.  
  739.     /* make this window in VIEW mode, update all mode lines */
  740.     curwp->w_bufp->b_mode |= MDVIEW;
  741.     wp = wheadp;
  742.     while (wp != NULL) {
  743.         wp->w_flag |= WFMODE;
  744.         wp = wp->w_wndp;
  745.     }
  746.  
  747.     /* and get rid of the temporary file */
  748.     delete(filnam);
  749.     return(TRUE);
  750. }
  751.  
  752. PASCAL NEAR filter(int f, int n)
  753. {
  754.         register int    s;    /* return status from CLI */
  755.     register BUFFER *bp;    /* pointer to buffer to zot */
  756.         char line[NLINE];    /* command line send to shell */
  757.     char tmpnam[NFILEN];    /* place to store real file name */
  758.     static char bname1[] = "fltinp.com";
  759.  
  760.     static char filnam1[] = "fltinp.com";
  761.     static char filnam2[] = "fltout.log";
  762.  
  763.     /* don't allow this command if restricted */
  764.     if (restflag)
  765.         return(resterr());
  766.  
  767.     if (curbp->b_mode&MDVIEW)    /* don't allow this command if    */
  768.         return(rdonly());    /* we are in read only mode    */
  769.  
  770.     /* get the filter name and its args */
  771.         if ((s=mlreply("#", line, NLINE)) != TRUE)
  772.                 return(s);
  773.  
  774.     /* setup the proper file names */
  775.     bp = curbp;
  776.     strcpy(tmpnam, bp->b_fname);    /* save the original name */
  777.     strcpy(bp->b_fname, bname1);    /* set it to our new one */
  778.  
  779.     /* write it out, checking for errors */
  780.     if (writeout(filnam1, "w") != TRUE) {
  781.         mlwrite(TEXT2);
  782. /*                      "[Cannot write filter file]" */
  783.         strcpy(bp->b_fname, tmpnam);
  784.         return(FALSE);
  785.     }
  786.  
  787.         TTputc('\n');            /* Already have '\r'    */
  788.         TTflush();
  789.         TTclose();            /* stty to old modes    */
  790.     s = 1;
  791.  
  792.     test( LIB$SPAWN( descptr( line), descptr( filnam1), descptr( filnam2),
  793.         0, 0, 0, &s, 0, 0, 0, 0));
  794.         TTopen();
  795.         TTflush();
  796.         sgarbf = TRUE;
  797.         s &= 1;
  798.  
  799.     /* on failure, escape gracefully */
  800.     if (!s || (readin(filnam2,FALSE) == FALSE)) {
  801.         mlwrite(TEXT3);
  802. /*                      "[Execution failed]" */
  803.         strcpy(bp->b_fname, tmpnam);
  804.         delete(filnam1);
  805.         delete(filnam2);
  806.         return(s);
  807.     }
  808.  
  809.     /* reset file name */
  810.     strcpy(bp->b_fname, tmpnam);    /* restore name */
  811.     bp->b_flag |= BFCHG;        /* flag it as changed */
  812.  
  813.     /* and get rid of the temporary file */
  814.     delete(filnam1);
  815.     delete(filnam2);
  816.     return(TRUE);
  817. }
  818.  
  819. /*
  820.     The rename() function is built into the VMS C RTL, and need not be
  821.     duplicated here.
  822. */
  823.  
  824. char *PASCAL NEAR timeset()
  825. {
  826.     register char *sp;        /* temp string pointer */
  827.     char buf[16];        /* time data buffer */
  828.  
  829.     time(buf);
  830.     sp = ctime(buf);
  831.     sp[strlen(sp)-1] = 0;
  832.     return(sp);
  833. }
  834.  
  835. /*    FILE Directory routines        */
  836.  
  837. static char fname[NFILEN];        /* path of file to find */
  838. static char path[NFILEN];        /* path of file to find */
  839. static char rbuf[NFILEN];        /* return file buffer */
  840. static char *ctxtp = NULL;        /* context pointer */
  841. static struct dsc$descriptor pat_desc;    /* descriptor for pattern */
  842. static struct dsc$descriptor rbuf_desc;    /* descriptor for returned file name */
  843.  
  844. /*
  845.  * Do a wild card directory search (for file name completion)
  846.  * fspec is the pattern to match.
  847.  */
  848. char *PASCAL NEAR getffile(char *fspec)
  849.  
  850. {
  851.     register int index;        /* index into various strings */
  852.     register int point;        /* index into other strings */
  853.     register int extflag;        /* does the file have an extention? */
  854.     register int verflag;        /* does the file have a version? */
  855.     register char *cp, c;
  856.  
  857.     /* first parse the file path off the file spec */
  858.     strcpy(path, fspec);
  859.     index = strlen(path) - 1;
  860.     while (index >= 0 && (path[index] != ']' && path[index] != ':'))
  861.         --index;
  862.  
  863.     path[index+1] = 0;
  864.  
  865.     /* check for a version number */
  866.     point = strlen(fspec) - 1;
  867.     verflag = FALSE;
  868.     while (point >= 0) {
  869.         if ((c=fspec[point]) == ';') {
  870.             verflag = TRUE;
  871.             break;
  872.         } else if (c == '.' || c == ']' || c == ':')
  873.             break;
  874.         point--;
  875.     }
  876.  
  877.     /* check for an extension */
  878.     point = strlen(fspec) - 1;
  879.     extflag = FALSE;
  880.     while (point >= 0) {
  881.         if ((c=fspec[point]) == '.') {
  882.             extflag = TRUE;
  883.             break;
  884.         } else if (c == ']' || c == ':')
  885.             break;
  886.         point--;
  887.     }
  888.  
  889.     /* construct the composite wild card spec */
  890.     strcpy(fname, path);
  891.     strcat(fname, &fspec[index+1]);
  892.     strcat(fname, "*");
  893.     if (!extflag)
  894.         strcat(fname, ".*");
  895.     if (!verflag)
  896.         strcat(fname, ";*");
  897.  
  898.     pat_desc.dsc$a_pointer = fname;
  899.     pat_desc.dsc$w_length = strlen(fname);
  900.     pat_desc.dsc$b_dtype = DSC$K_DTYPE_T;
  901.     pat_desc.dsc$b_class = DSC$K_CLASS_S;
  902.  
  903.     for (cp=rbuf; cp!=rbuf+NFILEN; *cp++=' ') ;
  904.     rbuf_desc.dsc$a_pointer = rbuf;
  905.     rbuf_desc.dsc$w_length = NFILEN;
  906.     rbuf_desc.dsc$b_dtype = DSC$K_DTYPE_T;
  907.     rbuf_desc.dsc$b_class = DSC$K_CLASS_S;
  908.  
  909.     LIB$FIND_FILE_END(&ctxtp);
  910.     ctxtp = NULL;
  911.     if (LIB$FIND_FILE(&pat_desc, &rbuf_desc, &ctxtp) != RMS$_SUC)
  912.         return(NULL);
  913.  
  914.     /* return the first file name!
  915.      * isolate the filename and extension
  916.      * and append that on to the original path
  917.      */
  918.     for (cp=rbuf; *cp!=' ' && cp!=rbuf+NFILEN-1; cp++) ;
  919.     *cp = 0;
  920.     for (cp--; *cp!=';' && cp!=rbuf-1; cp--) ;
  921.     *cp = 0;
  922.     for (cp--; *cp!=']' && cp!=rbuf-1; cp--) ;
  923.     strcat(path,++cp);
  924.     mklower(path);
  925.     return(path);
  926. }
  927.  
  928. char *PASCAL NEAR getnfile()
  929. {
  930.     register int index;        /* index into various strings */
  931.     register int point;        /* index into other strings */
  932.     register int extflag;        /* does the file have an extention? */
  933.     char fname[NFILEN];        /* file/path for DOS call */
  934.     register char *cp;
  935.  
  936.     /* and call for the next file */
  937.     for (cp=rbuf; cp!=rbuf+NFILEN; *cp++=' ') ;
  938.     if (LIB$FIND_FILE(&pat_desc, &rbuf_desc, &ctxtp) != RMS$_SUC)
  939.         return(NULL);
  940.  
  941.     /* return the next file name!
  942.      * isolate the original path,
  943.      * isolate the filename and extension,
  944.      * and append filename/extension on to the original path
  945.      */
  946.     for (cp=path+strlen(path)-1; *cp!=']' && cp!=path-1; cp--)
  947.         ;
  948.  
  949.     *++cp = 0;
  950.     for (cp=rbuf; *cp!=' ' && cp!=rbuf+NFILEN-1; cp++)
  951.         ;
  952.     *cp = 0;
  953.     for (cp--; *cp!=';' && cp!=rbuf-1; cp--)
  954.         ;
  955.     *cp = 0;
  956.     for (cp--; *cp!=']' && cp!=rbuf-1; cp--)
  957.         ;
  958.     strcat(path,++cp);
  959.     mklower(path);
  960.     return(path);
  961. }
  962.  
  963. /*
  964.     The following ME$EDIT entry point is used when MicroEmacs is
  965.     called up from MAIL or NOTES.  Note that it may be called more than
  966.     once, and that "main()" is never called.
  967.  
  968.     Mail/Notes entry point.  Should be declared UNIVERSAL in ME.OPT.
  969. */
  970. ME$EDIT(struct dsc$descriptor *infile, struct dsc$descriptor *outfile)
  971. {
  972.     static int first_time = 1;
  973.     char *instr, *outstr;
  974.     register int status;
  975.     register BUFFER *bp;    /* buffer list pointer */
  976.     char bname[NBUFN];        /* buffer name of file to read */
  977.  
  978.     eexitflag = FALSE;
  979.     called = 1;
  980.     if (first_time)
  981.     {
  982.     first_time = 0;
  983.     vtinit();
  984.     if (eexitflag) goto abortrun;
  985.     edinit(mainbuf);     /* Buffers, windows */
  986.     varinit();        /* user variables */
  987.     initchars();        /* character set definitions */
  988.     dcline( 0, NULL, TRUE);
  989.     }
  990.     else TTopen();
  991.  
  992.     outstr = strncpy( calloc( 1, 1+outfile->dsc$w_length),
  993.     outfile->dsc$a_pointer, outfile->dsc$w_length);
  994.  
  995.     if (infile->dsc$w_length <= 0)
  996.     instr = outstr;
  997.     else instr = strncpy( calloc( 1, 1+infile->dsc$w_length),
  998.     infile->dsc$a_pointer, infile->dsc$w_length);
  999.  
  1000.     makename( bname, outstr);
  1001.     unqname(bname);
  1002.     bp = bfind(bname, TRUE, 0);
  1003.     strcpy(bp->b_fname, instr);
  1004.     bp->b_active = FALSE;
  1005.     swbuffer( bp);
  1006.     strcpy(bp->b_fname, outstr);
  1007.     bp->b_flag |= BFCHG;            /* flag it as changed */
  1008.     free( instr);
  1009.     free( outstr);
  1010.     sgarbf = TRUE;
  1011.     status = editloop();
  1012.  
  1013. abortrun:
  1014.     TTclose();
  1015.     return( status);
  1016. }
  1017.  
  1018. PASCAL NEAR bktoshell(int f, int n)
  1019. {
  1020. /*
  1021.     Pause this process and wait for it to be woken up
  1022. */
  1023.     unsigned pid;
  1024.     unsigned char *env, *dir;
  1025.     int argc;
  1026.     char *argv[ 16];
  1027.  
  1028.     if (called)
  1029.     {
  1030.     mlwrite( "Called MicroEMACS can't be suspended.");
  1031.     return( FALSE);
  1032.     }
  1033.  
  1034.     env = getenv("MICROEMACS$PARENT");
  1035.  
  1036.     if (env == NULL)
  1037.     {
  1038.     mlwrite( "No parent process.");
  1039.     return( FALSE);
  1040.     }
  1041.     movecursor(term.t_nrow, 0);
  1042.     TTclose();
  1043.  
  1044.     test( LIB$DELETE_LOGICAL(
  1045.     DESCPTR( "MICROEMACS$PARENT"),
  1046.     DESCPTR( "LNM$JOB")));
  1047.     test( LIB$GETJPI( &JPI$_PID, 0, 0, &pid, 0, 0));
  1048.     test( LIB$SET_LOGICAL(
  1049.     DESCPTR( "MICROEMACS$PROCESS"),
  1050.     descptr( int_asc( pid)),
  1051.     DESCPTR( "LNM$JOB")));
  1052.     pid = asc_int( env);
  1053.     test( SYS$WAKE( &pid, 0));
  1054.  
  1055.     for(;;)
  1056.     {    /* Hibernate until MICROEMACS$COMMAND is defined */
  1057.     test( SYS$HIBER());
  1058.     env = getenv( "MICROEMACS$COMMAND");    /* Command line arguments */
  1059.     if (env != NULL) break;    /* Winter is over */
  1060.     }
  1061.  
  1062.     test( LIB$DELETE_LOGICAL(
  1063.     DESCPTR( "MICROEMACS$COMMAND"),
  1064.     DESCPTR( "LNM$JOB")));
  1065.  
  1066.     TTopen();
  1067.  
  1068.     argv[ 0] = env;
  1069.     argc = 1;
  1070.     for( ; ;)
  1071.     {    /* Define each argument */
  1072.     if (*env == 0x80)
  1073.     { /* Seperator */
  1074.         argv[argc++] = env+1;
  1075.         if (argc > 15) break;
  1076.         *env++ = 0;
  1077.     }
  1078.     else if (*env++ == 0) break;
  1079.     }
  1080. /*
  1081.     First parameter is default device
  1082. */
  1083.     test( LIB$SET_LOGICAL(
  1084.     DESCPTR( "SYS$DISK"),
  1085.     descptr( argv[ 0]),
  1086.     0));
  1087. /*
  1088.     Second argument is default directory
  1089. */
  1090.     test( SYS$SETDDIR( descptr( argv[ 1]), 0, 0));
  1091. /*
  1092.     Remaining came from command line
  1093. */
  1094.     sgarbf = TRUE;
  1095.     dcline( argc-2, &argv[ 2], FALSE);
  1096.     return( TRUE);
  1097. }
  1098.  
  1099. #if RMSIO
  1100. /*
  1101.  * Here are the much faster I/O routines.  Skip the C stuff, use
  1102.  * the VMS I/O calls.  Puts the files in standard VMS format, too.
  1103.  */
  1104. #define successful(s)    ((s) & 1)
  1105. #define unsuccessful(s) (!((s) & 1))
  1106.  
  1107. static struct FAB fab;        /* a file access block */
  1108. static struct RAB rab;        /* a record access block */
  1109.  
  1110. /*
  1111.  * Open a file for reading.
  1112.  */
  1113. PASCAL NEAR ffropen(char *fn)
  1114. {
  1115.         unsigned long status;
  1116.  
  1117.     /* initialize structures */
  1118.     fab=cc$rms_fab;
  1119.     rab=cc$rms_rab;
  1120.  
  1121.     fab.fab$l_fna = fn;
  1122.     fab.fab$b_fns = strlen(fn);
  1123.     fab.fab$b_fac = FAB$M_GET;
  1124.     fab.fab$b_shr = FAB$M_SHRGET;
  1125.     fab.fab$l_fop = FAB$M_SQO;
  1126.  
  1127.     rab.rab$l_fab = &fab;
  1128.     rab.rab$l_rop = RAB$M_RAH;    /* read-ahead for multibuffering */
  1129.  
  1130.     status=SYS$OPEN(&fab);
  1131.     if (status==RMS$_FLK)
  1132.     {
  1133.         /*
  1134.          * File locking problem:
  1135.          * Add the SHRPUT option, allowing shareability
  1136.          * with other writers. This lets us read batch
  1137.          * logs and stuff like that. I don't turn it on
  1138.          * automatically since adding this sharing
  1139.          * eliminates the read-ahead
  1140.          */
  1141.         fab.fab$b_shr |= FAB$M_SHRPUT;
  1142.         status=SYS$OPEN(&fab);
  1143.     }
  1144.  
  1145.     if (successful(status))
  1146.     {
  1147.         if (unsuccessful(SYS$CONNECT(&rab)))
  1148.         {
  1149.             SYS$CLOSE(&fab);
  1150.             return(FIOFNF);
  1151.         }
  1152.     }
  1153.     else return(FIOFNF);
  1154.  
  1155.         return(FIOSUC);
  1156. }
  1157.  
  1158. /*
  1159.  * PASCAL NEAR ffwopen(char *fn, char *mode)
  1160.  *
  1161.  * fn = file name, mode = mode to open file.
  1162.  */
  1163. PASCAL NEAR ffwopen(char *fn, char *mode)
  1164. {
  1165.     unsigned long status;
  1166.  
  1167.     /* initialize structures */
  1168.     fab=cc$rms_fab;
  1169.     rab=cc$rms_rab;
  1170.  
  1171.     fab.fab$l_fna = fn;
  1172.     fab.fab$b_fns = strlen(fn);
  1173.     fab.fab$b_fac = FAB$M_PUT;    /* writing this file */
  1174.     fab.fab$b_shr = FAB$M_NIL;    /* no other writers */
  1175.     fab.fab$l_fop = FAB$M_SQO;    /* sequential ops only */
  1176.     fab.fab$b_rat = FAB$M_CR;    /* carriage returns on ends */
  1177.     fab.fab$b_rfm = FAB$C_VAR;    /* variable length file */
  1178.  
  1179.     rab.rab$l_fab = &fab;
  1180.     rab.rab$l_rop = RAB$M_WBH;    /* write behind - multibuffer */
  1181.  
  1182.     if (*mode == 'a')
  1183.     {
  1184.         /* append mode */
  1185.         rab.rab$l_rop = RAB$M_EOF;
  1186.         status=SYS$OPEN(&fab);
  1187.         if (status == RMS$_FNF)
  1188.             status=SYS$CREATE(&fab);
  1189.     }
  1190.     else    /* *mode == 'w' */
  1191.     {
  1192.         /* write mode */
  1193.            fab.fab$l_fop |= FAB$M_MXV; /* always make a new version */
  1194.         status=SYS$CREATE(&fab);
  1195.     }
  1196.  
  1197.     if (successful(status))
  1198.     {
  1199.          status=SYS$CONNECT(&rab);
  1200.          if (unsuccessful(status)) SYS$CLOSE(&fab);
  1201.     }
  1202.  
  1203.         if (unsuccessful(status)) {
  1204.                 mlwrite(TEXT155);
  1205. /*                      "Cannot open file for writing" */
  1206.                 return(FIOERR);
  1207.         }
  1208.         return(FIOSUC);
  1209. }
  1210.  
  1211. /*
  1212.  * Close a file. Should look at the status in all systems.
  1213.  */
  1214. PASCAL NEAR ffclose()
  1215. {
  1216.     unsigned long status;
  1217.  
  1218.     /* free this since we do not need it anymore */
  1219.     if (fline) {
  1220.         free(fline);
  1221.         fline = NULL;
  1222.     }
  1223.  
  1224.     status = SYS$DISCONNECT(&rab);
  1225.     if (successful(status)) status = SYS$CLOSE(&fab);
  1226.     else SYS$CLOSE(&fab);
  1227.  
  1228.         if (unsuccessful(status)) {
  1229.                 mlwrite(TEXT156);
  1230. /*                      "Error closing file" */
  1231.                 return(FIOERR);
  1232.         }
  1233.         return(FIOSUC);
  1234. }
  1235.  
  1236. /*
  1237.  * Write a line to the already opened file. The "buf" points to the buffer,
  1238.  * and the "nbuf" is its length, less the free newline. Return the status.
  1239.  * Check only at the newline.
  1240.  */
  1241. PASCAL NEAR ffputline(char buf[], int nbuf)
  1242. {
  1243.         register char *obuf=buf;
  1244.  
  1245. #if    CRYPT
  1246.     if (cryptflag)
  1247.     {
  1248.         /* get a reasonable buffer */
  1249.         if (fline && flen < nbuf)
  1250.         {
  1251.             free(fline);
  1252.             fline = NULL;
  1253.         }
  1254.  
  1255.         if (fline == NULL)
  1256.         {
  1257.             if ((fline=malloc(flen = nbuf+NSTRING))==NULL)
  1258.             {
  1259.                 return(FIOMEM);
  1260.             }
  1261.         }
  1262.  
  1263.         /* copy data */
  1264.         memcpy(fline,buf,nbuf);
  1265.  
  1266.         /* encrypt it */
  1267.         crypt(fline,nbuf);
  1268.  
  1269.         /* repoint output buffer */
  1270.         obuf=fline;
  1271.     }
  1272. #endif
  1273.  
  1274.         /* set output buffer */
  1275.     rab.rab$l_rbf = obuf;
  1276.     rab.rab$w_rsz = nbuf;
  1277.  
  1278.     if (unsuccessful(SYS$PUT(&rab))) {
  1279.                 mlwrite(TEXT157);
  1280. /*                      "Write I/O error" */
  1281.                 return(FIOERR);
  1282.         }
  1283.  
  1284.         return(FIOSUC);
  1285. }
  1286.  
  1287. /*
  1288.  * Read a line from a file, and store the bytes in the supplied buffer. The
  1289.  * "nbuf" is the length of the buffer. Complain about long lines and lines
  1290.  * at the end of the file that don't have a newline present. Check for I/O
  1291.  * errors too. Return status.
  1292.  */
  1293. PASCAL NEAR ffgetline()
  1294. {
  1295.     unsigned long status;
  1296.  
  1297.     /* if we don't have an fline, allocate one */
  1298.     if (fline == NULL)
  1299.         if ((fline = malloc(flen = fab.fab$w_mrs?fab.fab$w_mrs+1:32768)) == NULL)
  1300.             return(FIOMEM);
  1301.  
  1302.     /* read the line in */
  1303.     rab.rab$l_ubf=fline;
  1304.     rab.rab$w_usz=flen;
  1305.  
  1306.     status=SYS$GET(&rab);
  1307.     if (status == RMS$_EOF) return(FIOEOF);
  1308.         if (unsuccessful(status)) {
  1309.                 mlwrite(TEXT158);
  1310. /*                      "File read error" */
  1311.                 return(FIOERR);
  1312.         }
  1313.  
  1314.     /* terminate and decrypt the string */
  1315.         fline[rab.rab$w_rsz] = 0;
  1316. #if    CRYPT
  1317.     if (cryptflag)
  1318.         crypt(fline, strlen(fline));
  1319. #endif
  1320.         return(FIOSUC);
  1321. }
  1322.  
  1323. #endif
  1324.  
  1325. /***********************************************************
  1326. * FUNCTION - addspec - utility function for expandargs
  1327. ***********************************************************/
  1328. #define ADDSPEC_INCREMENT 10
  1329. static void PASCAL NEAR addspec(struct dsc$descriptor dsc, int *pargc,
  1330.                 char ***pargv, int *pargcapacity)
  1331. {
  1332.     char *s;
  1333.  
  1334.     /* reallocate the argument array if necessary */
  1335.     if (*pargc == *pargcapacity)
  1336.     {
  1337.         if (*pargv)
  1338.             *pargv = realloc(*pargv,sizeof(**pargv) * (*pargcapacity += ADDSPEC_INCREMENT));
  1339.         else
  1340.             *pargv = malloc(sizeof(**pargv) * (*pargcapacity += ADDSPEC_INCREMENT));
  1341.     }
  1342.  
  1343.  
  1344.     /* allocate new argument */
  1345.     s=strncpy(malloc(dsc.dsc$w_length+1),dsc.dsc$a_pointer,dsc.dsc$w_length);
  1346.     s[dsc.dsc$w_length]=0;
  1347.  
  1348.     /* put into array */
  1349.     (*pargv)[(*pargc)++] = s;
  1350. }
  1351.  
  1352. /***********************************************************
  1353. * FUNCTION - expandargs - massage argc and argv to expand
  1354. * wildcards by calling VMS.
  1355. ***********************************************************/
  1356. void PASCAL NEAR expandargs(int *pargc, char ***pargv)
  1357. {
  1358.     int argc = *pargc;
  1359.     char **argv = *pargv;
  1360.  
  1361.     int nargc=0;
  1362.     char **nargv=NULL;
  1363.     int nargcapacity=0;
  1364.  
  1365.     struct dsc$descriptor result_filespec={0,DSC$K_DTYPE_T,DSC$K_CLASS_D,NULL};
  1366.  
  1367.     /* loop over all arguments */
  1368.     while (argc--)
  1369.     {
  1370.     struct dsc$descriptor filespec={strlen(*argv),DSC$K_DTYPE_T,DSC$K_CLASS_S,*argv};
  1371.     unsigned long context=0;
  1372.  
  1373.     /* should check for wildcards: %, *, and "..." */
  1374.     if (**argv != '-' && (strchr(*argv,'%') || strchr(*argv,'*') ||
  1375.                   strstr(*argv,"...")))
  1376.     {
  1377.         /* search for all matching filenames */
  1378.         while ((LIB$FIND_FILE(&filespec,&result_filespec,&context)) & 1)
  1379.         {
  1380.             int i;
  1381.  
  1382.             /* LIB$FIND_FILE returns uppercase. Lowercase it */
  1383.             for (i=0;i<result_filespec.dsc$w_length;i++)
  1384.                 if (isupper(result_filespec.dsc$a_pointer[i]))
  1385.                     result_filespec.dsc$a_pointer[i] = tolower(result_filespec.dsc$a_pointer[i]);
  1386.  
  1387.                     addspec(result_filespec,&nargc,&nargv,&nargcapacity);
  1388.             }
  1389.         }
  1390.         else
  1391.         addspec(filespec,&nargc,&nargv,&nargcapacity);
  1392.  
  1393.         LIB$FIND_FILE_END(&context);
  1394.  
  1395.         argv++;
  1396.     }
  1397.  
  1398.     STR$FREE1_DX(&result_filespec);
  1399.  
  1400.     *pargc=nargc;
  1401.     *pargv=nargv;
  1402. }
  1403.  
  1404. #else
  1405. PASCAL NEAR vms_hello()
  1406. {
  1407. }
  1408. #endif
  1409.