PACKET elan lister DEFINES                            (* Autor: J.Liedtke *)
                                                      (* Stand: 22.03.84  *)
      is elan source ,
      elan list :
 

LET source lines per page  = 64 ,
    x start                = 1 ,
    y start                = 2 ,

    tag                    = 1 ,
    bold                   = 2 ,
 
    linelength             = 120 ,
    struct comment length  = 32 ,
    max name length        = 25 ,
    struct comment blanks  = "                                " ,
    refinement layout line = "                                     |" ,
    headline pre =
       " Zeile    *****   E L A N    EUMEL 1.7  *****   " ;
 
INT VAR  symbol type ,
         line nr ,
         page nr ,
         line at page ;

BOOL VAR within defines list ;

TEXT VAR record,
         list pre ,
         source name ,
         source prefix ,
         symbol,
         ahead symbol ,
         bottom blanks := (linelength) * " " ;


PROC elan list (FILE VAR source) :
 
  initialize listing ;
  within defines list := FALSE ;
  WHILE NOT eof (source) REP
    list one source line ;
    line nr INCR 1
  PER ;
  page bottom ;
  start (0.0,0.0) ;
  new page .

initialize listing :
  reset printer ;
  construct source name and prefix ;
  print first page head ;
  line nr := 1 .

construct source name and prefix :
  source name := headline (source) ;
  INT CONST slash pos := pos (source name, "/") ;
  IF slash pos = 0
    THEN source prefix := ""
    ELSE source prefix := subtext (source name, slash pos+1) + "/" ;
         source name   := subtext (source name, 1, slash pos-1) 
  FI .

list one source line :
  getline (source, record) ;
  print list pre ;
  printline (record) ;
  page if necessary .

print list pre :
  list pre := text (line nr, 5) ;
  IF pos (record, "P") = 0 AND pos (record, ":") = 0
    THEN empty layout
    ELSE analyze source line
  FI ;
  list pre CAT ("|") ;
  print text (list pre, 0) .

empty layout :
  list pre CAT struct comment blanks .
 
analyze source line :
  scan (record) ;
  next symbol (symbol, symbol type) ;
  next symbol (ahead symbol) ;
  IF   begin of packet     THEN packet layout 
  ELIF within defines list THEN check end of defines part
  ELIF begin of proc op    THEN proc op layout
  ELIF begin of refinement THEN refinement layout
  ELSE                          empty layout
  FI .
 
begin of packet :
  symbol = "PACKET" .
 
begin of proc op :
  IF   is proc or op (symbol)
    THEN TRUE
  ELIF (symbol <> "END") AND  is proc or op (ahead symbol)
    THEN symbol := ahead symbol ;
         next symbol (ahead symbol) ; TRUE
    ELSE FALSE
  FI .
 
begin of refinement :
  symbol type = tag AND ahead symbol = ":" AND NOT within defines list .
 
packet layout :
  IF not at page head
    THEN page bottom ;
         page head
  FI ;
  layout ("   ", ahead symbol, "*") ;
  within defines list := TRUE .

check end of defines part :
  empty layout ;
  scan (record) ;
  REP
    nextsymbol (symbol) ;
    IF symbol = ":"
      THEN within defines list := FALSE
    FI
  UNTIL symbol = "" PER .

proc op layout :
(*printline ("") ;*)
  printline ("") ;
  printline ("") ;
  IF not two free lines 
    THEN page bottom ;
         page head
  FI ; 
  layout ("   ", ahead symbol, ".") .
 
refinement layout :
(*print line (refinement layout line) ;*)
  print line (refinement layout line) ;
  IF not two free lines THEN page bottom; page head FI; 
  layout ("      ", symbol, " ") .
 

print first page head :
  page nr := 1 ;
  page head .

page if necessary :
  IF line at page > source lines per page
    THEN page bottom ;
         page head
  FI .

not two free lines :
  line at page >= source lines per page - 2 .

not at page head :
  line at page > 5 .

ENDPROC elan list ;
 
BOOL PROC is proc or op (TEXT CONST symbol) :

  symbol = "PROC" OR symbol = "PROCEDURE"
  OR symbol = "OP" OR symbol = "OPERATOR" 

ENDPROC is proc or op ;
 
PROC layout (TEXT CONST pre, TEXT VAR name, TEXT CONST post) :

  list pre CAT pre ;
  name := subtext (name, 1, max name length) ;
  list pre CAT name ;
  list pre CAT " " ;
  generate remaining struct comment .
 
generate remaining struct comment :
  INT VAR i ;
  FOR i FROM 1 UPTO remaining struct comment length REP
    list pre CAT post
  PER .

remaining struct comment length :
  struct comment length - LENGTH pre - min(LENGTH name,max name length) - 1.
 
ENDPROC layout ;

PROC print line (TEXT CONST line text) :

  print text (line text, 0) ;
  line (1.0) ;
  line at page INCR 1

ENDPROC print line ;

PROC printtext (TEXT CONST t, BOOL CONST b) :
  out (t)
ENDPROC printtext ;       (*** sonst im Hardwaretreiber *********)

PROC page head :

  new page ;
  print text (headline pre, 0) ;
  print text (date, 0);           (* R. Nolting 27.10.83 *)
  print text ("   *****     ",0);
  print text (source name, 0) ;
  line (4.0) ;
  line at page := 1 

ENDPROC page head ;

PROC page bottom :

  WHILE line at page < source lines per page REP
    line (1.0) ;
    line at page INCR 1
  PER ;
  line (1.0) ;
  printtext (text (source prefix + text (page nr), 8), FALSE) ;
  printtext (bottom blanks, FALSE) ;
  printtext (source prefix + text (page nr), FALSE) ;
  line (1.0) ;
  page nr INCR 1 .

ENDPROC page bottom ;

BOOL PROC is elan source (FILE VAR source) :

  input (source) ;
  get first symbol ;
  symbol type = tag COR is bold begin of program COR is comment .

is bold begin of program :
  symbol type = bold CAND is elan bold .

is elan bold :
  symbol = "PACKET" COR is proc or op (symbol) COR is data declaration .

is data declaration :
  next symbol (symbol) ;
  symbol = "VAR" OR symbol = "CONST" .

is comment :
  pos (record, "(*") > 0 OR pos (record, "{") > 0 .


get first symbol :
  get first non blank record ;
  scan (record) ;
  next symbol (symbol, symbol type) ;
  reset (source) .

get first non blank record :
  REP
    getline (source, record)
  UNTIL record contains non blank OR eof (source) PER .

record contains non blank :
  pos (record, ""33"",""254"", 1) > 0 .

ENDPROC is elan source ;

ENDPACKET elan lister ;