~ubuntu-branches/ubuntu/wily/eso-midas/wily-proposed

« back to all changes in this revision

Viewing changes to system/ext/getline.c

  • Committer: Package Import Robot
  • Author(s): Ole Streicher
  • Date: 2014-04-22 14:44:58 UTC
  • Revision ID: package-import@ubuntu.com-20140422144458-okiwi1assxkkiz39
Tags: upstream-13.09pl1.2+dfsg
ImportĀ upstreamĀ versionĀ 13.09pl1.2+dfsg

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
/*===========================================================================
 
2
  Copyright (C) 1987-2009 European Southern Observatory (ESO)
 
3
 
 
4
  This program is free software; you can redistribute it and/or 
 
5
  modify it under the terms of the GNU General Public License as 
 
6
  published by the Free Software Foundation; either version 2 of 
 
7
  the License, or (at your option) any later version.
 
8
 
 
9
  This program is distributed in the hope that it will be useful,
 
10
  but WITHOUT ANY WARRANTY; without even the implied warranty of
 
11
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
12
  GNU General Public License for more details.
 
13
 
 
14
  You should have received a copy of the GNU General Public 
 
15
  License along with this program; if not, write to the Free 
 
16
  Software Foundation, Inc., 675 Massachusetts Ave, Cambridge, 
 
17
  MA 02139, USA.
 
18
 
 
19
  Correspondence concerning ESO-MIDAS should be addressed as follows:
 
20
        Internet e-mail: midas@eso.org
 
21
        Postal address: European Southern Observatory
 
22
                        Data Management Division 
 
23
                        Karl-Schwarzschild-Strasse 2
 
24
                        D 85748 Garching bei Muenchen 
 
25
                        GERMANY
 
26
===========================================================================*/
 
27
 
 
28
/*+++++++++  Remove ESO extensions to FORTRAN 77    ++++++++++++++++++++
 
29
.COPYRIGHT   (c) 1994 European Southern Observatory
 
30
.LANGUAGE    C
 
31
.IDENT       getline.c
 
32
.AUTHOR      Preben J. Grosbol [ESO/IPG]
 
33
.KEYWORDS    ESO fortran, line input
 
34
.ENVIRONMENT UNIX
 
35
.COMMENT
 
36
.VERSION     1.0   10-Nov-1987: Creation,     PJG
 
37
.VERSION     1.1   14-Jan-1988: Replace tabs with space, PJG
 
38
.VERSION     1.2   15-Feb-1988: Replace form-feed with space, PJG
 
39
.VERSION     1.3   23-Mar-1988: Redefine 'c' as int, PJG
 
40
.VERSION     1.4   20-Dec-1988: Check for max. line ident., PJG
 
41
.VERSION     1.5   24-Jun-1992: Correct check for '' in format, PJG
 
42
.VERSION     1.6   27-Apr-1994: Warning for character after col.72, PJG
 
43
.VERSION     1.7   06-May-1994: Check only non-space after col72, PJG
 
44
 
 
45
 090903         last modif
 
46
------------------------------------------------------------------------*/
 
47
#include   <stdio.h>                        /* standard I/O functions   */
 
48
#include   <ctype.h>                        /* character types          */
 
49
#include   <f77ext.h>                       /* definition of constants  */
 
50
 
 
51
extern    int                  x_flag;      /* extension option flag    */
 
52
extern    int                   equal;      /* level zero equal sign    */
 
53
extern    int                   comma;      /* level zero comma         */
 
54
extern    int                     nlb;      /* present index in 'lbuf'  */
 
55
extern    int                 id_size;      /* length of identifier     */
 
56
extern    int                  no_lid;      /* no. of line identifiers  */
 
57
extern    int                   nstat;      /* char. index in 'stat'    */
 
58
extern    char                 stmt[];      /* present statement        */
 
59
extern    char   lbuf[MXLBUF][MXLINE];      /* buffer for input lines   */
 
60
extern    LID                   lid[];      /* list of line identifiers */
 
61
 
 
62
static    int                 q_level;      /* quote level in statement */
 
63
static    int                 p_level;      /* parenthesis level        */
 
64
static    char                 *pstat;      /* pointer to statement     */
 
65
 
 
66
char get_line(fp)                           /* add character to buffer  */
 
67
FILE         *fp;
 
68
{
 
69
  int          c, nlbuf, e_mark, ncol, ncx;
 
70
  char         *plbuf;
 
71
 
 
72
  ncol = 0; ncx = 0;
 
73
  if (!nstat) {                        /* reset at start of statement   */
 
74
    q_level = 0; p_level = 0;
 
75
    pstat = stmt; id_size = 0;
 
76
  }
 
77
 
 
78
  nlbuf = 0; e_mark = 0;
 
79
  plbuf = &lbuf[nlb][0];
 
80
 
 
81
  while ((c=getc(fp)) != '\n' && c != EOF) {  /* read rest of line      */
 
82
    if (c=='\t' || c=='\f') c = ' ';
 
83
    if (MXLINE<=nlbuf) continue;
 
84
    if (e_mark) {
 
85
      if (!(x_flag & EXC_FLAG)) { *plbuf++ = c; nlbuf++; }
 
86
      continue;
 
87
    }
 
88
    if (c=='\'') q_level = !q_level;
 
89
    if (c=='!' && !q_level) {
 
90
      if (!(x_flag & EXC_FLAG)) { *plbuf++ = c; nlbuf++; }
 
91
      e_mark = 1;
 
92
      continue;
 
93
    }
 
94
    if (65<ncol++ && c!=' ') ncx = 1;
 
95
    if (c==',' && !p_level && !q_level) comma = 1;
 
96
    if (c=='=' && !p_level && !q_level) equal = 1;
 
97
    if (!q_level && (x_flag & UPC_FLAG)) c = (islower(c)) ? toupper(c) : c;
 
98
 
 
99
    if (id_size && c!=' ') {                  /* check for identifiers */
 
100
      if (isalpha(c) || isdigit(c) || c=='_') /* continue identifier   */
 
101
        id_size++;
 
102
      else {                                  /* end of identifier     */
 
103
        lid[no_lid].size = id_size;
 
104
        lid[no_lid].level = p_level;
 
105
        lid[no_lid].id = (ID *) 0;
 
106
        id_size = 0;
 
107
        if (MXLID<=++no_lid)
 
108
           fprintf(stderr,"Error: Too many identifiers in statement\n");
 
109
      }
 
110
    }
 
111
    else if (!q_level && isalpha(c)) {        /* start of identifier   */
 
112
      lid[no_lid].sid = pstat;
 
113
      lid[no_lid].lid = plbuf;
 
114
      lid[no_lid].lno = nlb;
 
115
      id_size++;
 
116
    }
 
117
    if (c=='(') p_level++;
 
118
    if (c==')') p_level--;
 
119
    *plbuf++ = c; nlbuf++;
 
120
    if (c!=' ' || q_level) { *pstat++ = c; nstat++; }
 
121
  }
 
122
  if (id_size)  {                             /* end of identifier     */
 
123
        lid[no_lid].size = id_size;
 
124
        lid[no_lid].level = p_level;
 
125
        lid[no_lid].id = (ID *) 0;
 
126
        id_size = 0;
 
127
        if (MXLID<=++no_lid)
 
128
           fprintf(stderr,"Error: Too many identifiers in statement\n");
 
129
  }
 
130
  *plbuf = '\0';
 
131
  if (ncx) {                             /* characters after column 72 */
 
132
     fprintf(stderr,"esoext-warning: Non-space characters after column 72\n");
 
133
     fprintf(stderr," >%-75.75s\n",&lbuf[nlb][0]);
 
134
   }
 
135
  return c;
 
136
}