/* @(#)extutl.c	17.1.1.1 (ES0-DMD) 01/25/02 17:57:00 */
/*===========================================================================
  Copyright (C) 1995 European Southern Observatory (ESO)
 
  This program is free software; you can redistribute it and/or 
  modify it under the terms of the GNU General Public License as 
  published by the Free Software Foundation; either version 2 of 
  the License, or (at your option) any later version.
 
  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.
 
  You should have received a copy of the GNU General Public 
  License along with this program; if not, write to the Free 
  Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, 
  MA 02139, USA.
 
  Corresponding concerning ESO-MIDAS should be addressed as follows:
	Internet e-mail: midas@eso.org
	Postal address: European Southern Observatory
			Data Management Division 
			Karl-Schwarzschild-Strasse 2
			D 85748 Garching bei Muenchen 
			GERMANY
===========================================================================*/

/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.COPYRIGHT   (c) 1992 European Southern Observatory
.LANGUAGE    C
.IDENT       extutl.c
.AUTHOR      Preben J. Grosbol [ESO/IPG]
.KEYWORDS    file pointer, input/output files, include files
.PURPOSE     Utility routined for removal of ESO extensions to FORTRAN 77
.ENVIRON     UNIX
.VERSION     1.0   1987-Nov-12: Creation,     PJG
.VERSION     1.1   1988-Jan-14: Add LC include + labels,   PJG
.VERSION     1.2   1988-Feb-08: correct 'tolower',   PJG
.VERSION     1.3   1988-Mar-23: Redefine 'c' as int,   PJG
.VERSION     1.4   1988-Sep-08: Standard error lists,   PJG
.VERSION     1.5   1990-Dec-05: Add include search path,   PJG
.VERSION     1.6   1992-Aug-21: Correct error in incl_file(),   PJG
------------------------------------------------------------------------*/
#include   <stdio.h>                        /* standard I/O routines    */
#include   <ctype.h>                        /* get type definitions     */
#include   <f77ext.h>                       /* definition of constants  */
#include   <string.h> 

extern    int                  x_flag;      /* extension/option flag    */

static    char         xname[MXFNAME];      /* storage for extension    */
static    char         fname[MXFNAME];      /* storage for file name    */
static    char         iname[MXFNAME];      /* storage for include name */
static    char     lstack[MXLEVEL][6];      /* stack for labels         */
static    FILE        *stack[MXLEVEL];      /* file pointer stack       */
static    int              s_pntr = 0;      /* stack pointer            */
static    int              l_pntr = 0;      /* stack pointer            */

FILE *push_fp(fp,path,name)               /* push include file on stack */
FILE    *fp;
char    **path;
char    *name;
{
  char   *pc, *pp, *pn;
  FILE   *nfp;

  if (MXLEVEL<=s_pntr) {                 /* stack full - error          */
    fprintf(stderr,"Error: Include stack full\n"); exit(1);
  }
  stack[s_pntr++] = fp;                  /* push it on stack            */

  do {
    pp = *path;
    pc = fname;
    if (pp) {                            /* path of include file given  */
      while (*pc = *pp++) pc++;          /* copy path over              */
      *pc++ = '/';
      path++;
    }
    pn = name;
    while (*pc++ = *pn++);               /* copy name of include file   */
    nfp = fopen(fname,"r");              /* open include file           */
  } while (!nfp && *path);

  if (!nfp) {                            /* cannot open include file    */
    fprintf(stderr,"Error: Cannot open include file >%s<\n",fname);
    exit(1);
  }
  return nfp;
}

FILE *pop_fp(fp)                          /* pop include file off stack  */
FILE        *fp;
{
  FILE   *nfp;

  fclose(fp);                             /* close active file           */
  if (0<s_pntr) {                         /* files on the stack          */
    nfp = (s_pntr) ? stack[--s_pntr] : (FILE *) 0;
  }
  else {                                  /* no files on stack           */
    s_pntr = 0; nfp = (FILE *) 0;
  }
  return nfp;
}

char *push_lab(label)          /* push a label string on the stack       */
char     *label;
{
  char   *pc;

  pc = &(lstack[l_pntr++][0]);
  if (label) while ((*pc++ = *label++));
  *pc = '\0';

  if (MXLEVEL<=l_pntr) {                  /* stack full - error          */
    fprintf(stderr,"Error: Label stack full\n"); exit(1);
  }
  return (char *) 0;
}

char *pop_lab()                /* pop label string off the stack         */
{
  char   *plab;

  if (0<l_pntr) {                         /* labels on the stack         */
    plab = (l_pntr) ? &(lstack[--l_pntr][0]) : (char *) 0;
  }
  else {                                  /* no labels on stack          */
    l_pntr = 0; plab = (char *) 0;
  }
  return plab;
}

char *new_ext(name,ext)        /* generate file name with new extension */
char   *name;
char   *ext;
{
  char   *pc,*pcx;

  pc = xname; pcx = (char *) 0;
  while (*pc = *name++)             /* search for last '.' in file name */
    if (*pc++ == '.') pcx = pc;
  if (!pcx) *pc++ = '.';            /* if no '.' add it to end of name  */
    else pc = pcx;
  while (*pc++ = *ext++);
  if (MXFNAME<=strlen(xname)) {     /* file name was too long - error   */
    fprintf(stderr,"Error: File name >%s< too long\n",xname); exit(1);
  }

  return xname;
}

char *new_file()               /* get new file name from standard input */
{
  char *pc;
  int  n,c;

  n = 0; pc = fname;
  while ((c=getc(stdin)) != EOF && !isspace(c))   /* read new file name */
    if (n++<MXFNAME) *pc++ = c;
  while (isspace(c)) c = getc(stdin);             /* skip through space */
  ungetc(c,stdin);                        /* put first no-space back    */

  if (MXFNAME<=n) {                       /* file name too long - error */
    fprintf(stderr,"Error: File name >%s< too long - skipped!\n",fname);
    exit(1);
  }
  *pc = '\0';

  return (c==EOF && !n) ? (char *) 0 : fname;
}

char *incl_file(line)                 /* extract include file from line */
char      *line;
{
  char   *pcl,c; 
  int    n, colon;

  pcl = (char *) 0;
  while ((c = *line++)!='\'' && c);             /* find first ' in line */
  if (!c) { fprintf(stderr,"Error: Include statement error\n"); exit(1); }

  pcl = line;
  while ((c = *line++)!=':' && c);              /* check if ':' in line */
  colon = (c==':');                             /* true if colon found  */
  if (!c) line = pcl;                           /* no ':' reset pointer */

  n = 0;                                   /* copy include file name    */ 
  while ((c = *line++)!='\'' && c) {
     if (colon && c=='/') break;         /* due to '/' qualifier in VMS */
     if (n<MXFNAME-1) iname[n++] = c;
   }
  iname[n] = '\0';

  if (x_flag & LCI_FLAG) {                 /* convert to lower case     */
     pcl = iname;
     while (*pcl) {
       if (isupper((int)*pcl)) *pcl = tolower((int)*pcl); pcl++;
     }
  }

  return (c) ? iname : (char *) 0;
}