path: root/app/eudas/4.4/src/eudas.steuerung

PACKET eudas steuerung

(*************************************************************************)
(*                                                                       *)
(*     Menuesteuerung von EUDAS                                          *)
(*                                                                       *)
(*     Version 09                                                        *)
(*                                                                       *)
(*     Autor: Thomas Berlage                                             *)
(*     Stand: 01.10.87                                                   *)
(*                                                                       *)
(*************************************************************************)

  DEFINES

  eudas,

  einzelsicherung,
  suchen,
  aendern,
  einfuegen,
  prueffehler editieren,
  feldstruktur,

  dateiverwaltung,
  archivverwaltung,

  edit,
  dateinamen anfordern,
  ausfuehrung,
  einzelausfuehrung :


(**************************** Variablen ***********************************)

LET
  file typ = 1003,
  eudas typ = 3243;

LET
  niltext = "",
  blank = " ",
  esc z = ""27"z",
  cleop = ""4"",
  cleol = ""5"";


FILE VAR test file;

DATASPACE VAR test ds;

INT VAR
  belegter heap,
  test version := dateiversion - 1;

FENSTER VAR
  ganz,
  links,
  rechts,
  fuss;

TEXT VAR
  feldpuffer;

fenster initialisieren (ganz);
fenster initialisieren (links);
fenster initialisieren (rechts);
fenster initialisieren (fuss);
fenstergroesse setzen (ganz, 1, 2, 79, 23);
fenstergroesse setzen (links, 1, 2, 15, 22);
fenstergroesse setzen (rechts, 16, 2, 64, 22);
fenstergroesse setzen (fuss, 1, 24, 79, 1);
dialogfenster (16, 2, 64, 22);
anzeigefenster (16, 2, 64, 23);
uebersichtsfenster (1, 2, 79, 23);


(*************************** EUDAS ***************************************)

TEXT VAR
  fusszeile;

BOOL VAR
  eudas schon aktiv := FALSE;

LET
  menue 1 =  #1001#
    "EUDAS.Öffnen",
  menue 2 =  #1002#
    "EUDAS.Einzelsatz",
  menue 3 =  #1003#
    "EUDAS.Gesamtdatei",
  menue 4 =  #1004#
    "EUDAS.Drucken",
  menue 5 =  #1005#
    "EUDAS.Dateien",
  menue 6 =  #1006#
    "EUDAS.Archiv";

LET
  kein rekursiver aufruf =  #1007#
    "EUDAS kann nicht unter EUDAS aufgerufen werden",
  suchmuster eingeben =  #1008#
    "Suchbedingung einstellen",
  alle saetze drucken =  #1009#
    "Alle Saetze drucken",
  alle markierten saetze drucken =  #1010#
    "Alle markierten Satze drucken",
  einzelsatz drucken =  #1011#
    "Aktuellen Satz drucken",
  uebersicht wiederholen =  #1012#
    "Mit neuer Auswahl noch einmal",
  akt datei =  #1013#
    "Akt.Datei: ",
  datum doppelpunkt =  #1014#
    " Datum: ";


PROC version ausgeben :

  cursor (30, 6);
  out ("EEEEE U   U DDDD    A    SSSS");
  cursor (30, 7);
  out ("E     U   U D   D  A A  S");
  cursor (30, 8);
  out ("EEE   U   U D   D AAAAA  SSS");
  cursor (30, 9);
  out ("E     U   U D   D A   A     S");
  cursor (30, 10);
  out ("EEEEE  UUU  DDDD  A   A SSSS");
  cursor (30, 12);
  out ("Version 4.4");
  cursor (30, 13);
  out ("Stand: 01.10.87");
  cursor (30, 15);
  out ("(C) COPYRIGHT:");
  cursor (30, 16);
  out ("Thomas Berlage");
  cursor (30, 17);
  out ("Software-Systeme")

END PROC version ausgeben;

PROC eudas :

  IF aktueller editor > 0 THEN
    eudas kurzabfrage
  ELIF eudas schon aktiv THEN
    errorstop (kein rekursiver aufruf)
  ELSE
    eudas aufrufen
  END IF .

eudas aufrufen :
  page; bildschirm neu;
  version ausgeben;
  belegter heap := heap size;
  fusszeile aufbauen;
  disable stop;
  eudas schon aktiv := TRUE;
  menue anbieten (ROW 6 TEXT : (menue 1, menue 2, menue 3,
                                menue 4, menue 5, menue 6),
                  links, TRUE,
                  PROC (INT CONST, INT CONST) eudas interpreter);
  eudas schon aktiv := FALSE;
  enable stop;
  auf sicherung ueberpruefen;
  page; bildschirm neu

END PROC eudas;

PROC eudas kurzabfrage :

  TEXT VAR gewaehlte feldnamen;
  bild frei;
  auf sicherung ueberpruefen;
  IF nicht alle gesichert THEN
    LEAVE eudas kurzabfrage
  END IF;
  oeffnen im menue (FALSE);
  auf satz (1);
  feldauswahl fuer uebersicht (gewaehlte feldnamen);
  REP
    ggf suchmuster eingeben;
    uebersicht (gewaehlte feldnamen, PROC uebersicht hilfe);
    bild frei;
    saetze drucken
  UNTIL nicht noch einmal END REP;
  dateien loeschen (FALSE) .

nicht alle gesichert :
  INT VAR datei nr;
  FOR datei nr FROM 1 UPTO anzahl dateien REP
    IF inhalt veraendert (datei nr) THEN
      LEAVE nicht alle gesichert WITH TRUE
    END IF
  END REP;
  FALSE .

ggf suchmuster eingeben :
  IF ja (suchmuster eingeben, "JA/Suchmuster") THEN
    suchen; alles neu
  END IF .

saetze drucken :
  IF markierte saetze = 0 CAND alle drucken THEN
    dateinamen anfordern (name des druckmusters);
    einzelausfuehrung (PROC (TEXT CONST) drucke uebersicht, file typ);
  ELIF markierte saetze > 0 CAND alle markierten drucken THEN
    dateinamen anfordern (name des druckmusters);
    einzelausfuehrung (PROC (TEXT CONST) drucke uebersicht, file typ);
    markierungen loeschen
  ELIF einzelsatz THEN
    markierungen loeschen; markierung aendern;
    dateinamen anfordern (name des druckmusters);
    einzelausfuehrung (PROC (TEXT CONST) drucke uebersicht, file typ);
    markierungen loeschen
  END IF .

alle drucken :
  ja (alle saetze drucken, "JA/alle Satze") .

alle markierten drucken :
  ja (alle markierten saetze drucken, "JA/alle markierten") .

einzelsatz :
  ja (einzelsatz drucken, "JA/Einzelsatz drucken") .

nicht noch einmal :
  NOT ja (uebersicht wiederholen, "JA/noch einmal") .

END PROC eudas kurzabfrage;

PROC bild frei :

  bildschirm neu;
  cursor (1, 1);
  out (cleop);
  cursor (15, 1);
  23 TIMESOUT (""10":"8"")

END PROC bild frei;

PROC drucke uebersicht (TEXT CONST dateiname) :

  bild frei fuer uebersetzung;
  disable stop;
  drucke (dateiname);
  uebersetzungsfehler behandeln;
  bild frei

END PROC drucke uebersicht;

PROC eudas interpreter (INT CONST menuenr, wahl nr) :

  enable stop;
  SELECT menuenr OF
  CASE 0 : waehlbarkeit setzen
  CASE 1 : oeffnen interpreter (wahl nr)
  CASE 2 : anzeigen interpreter (wahl nr)
  CASE 3 : bearbeiten interpreter (wahl nr)
  CASE 4 : drucken interpreter (wahl nr)
  CASE 5 : dateiverwaltung (wahl nr)
  CASE 6 : archivverwaltung (wahl nr)
  END SELECT .

waehlbarkeit setzen :
  IF anzahl dateien = 0 THEN
    oeffnen sperre (FALSE);
    aendern sperre (FALSE)
  ELIF NOT aendern erlaubt THEN
    aendern sperre (FALSE)
  END IF;
  ketten koppeln sperre;
  waehlbar (6, 6, ziel ist manager);
  waehlbar (6, 9, NOT ziel ist manager);
  IF single user THEN
    waehlbar (1, 8, FALSE);   (* Manager *)
    waehlbar (6, 7, FALSE)    (* Zielarchiv *)
  END IF .

single user :
  FALSE .

END PROC eudas interpreter;

PROC oeffnen sperre (BOOL CONST wie) :

  INT VAR i;
  waehlbar (1, 4, wie);
  waehlbar (1, 5, wie);
  waehlbar (1, 7, wie);
  FOR i FROM 1 UPTO 11 REP
    waehlbar (2, i, wie)
  END REP;
  waehlbar (3, 1, wie);
  waehlbar (3, 4, wie);
  waehlbar (3, 6, wie);
  waehlbar (4, 1, wie)

END PROC oeffnen sperre;

PROC ketten koppeln sperre :

  BOOL VAR wie := anzahl dateien = 1 AND aendern erlaubt;
  waehlbar (1, 6, wie);
  waehlbar (3, 5, wie);
  wie := anzahl dateien > 0 AND anzahl dateien < 10 AND NOT auf koppeldatei;
  waehlbar (1, 2, wie);
  waehlbar (1, 3, wie)

END PROC ketten koppeln sperre;

PROC aendern sperre (BOOL CONST wie) :

  INT VAR i;
  FOR i FROM 7 UPTO 10 REP
    waehlbar (2, i, wie)
  END REP;
  waehlbar (3, 2, wie);
  waehlbar (3, 3, wie)

END PROC aendern sperre;

PROC fusszeile aufbauen :

  fenster veraendert (fuss);
  fusszeile := ""6""23""0"";
  fusszeile CAT akt datei;
  IF anzahl dateien > 0 THEN
    fusszeile CAT """";
    fusszeile CAT eudas dateiname (1);
    fusszeile CAT """"
  END IF;
  IF anzahl dateien > 1 THEN
    fusszeile CAT " .. "
  END IF;
  fusszeile CAT ""5""6""23"";
  fusszeile CAT code (79 - length (date) - length (datum doppelpunkt));
  fusszeile CAT datum doppelpunkt;
  fusszeile CAT date

END PROC fusszeile aufbauen;

PROC fusszeile ausgeben (TEXT CONST prompt, inhalt) :

  BOOL VAR fuss veraendert;
  fensterzugriff (fuss, fuss veraendert);
  IF fuss veraendert THEN
    out (fusszeile);
    cursor (35, 24);
    out (prompt);
    IF inhalt <> niltext THEN
      out (""""); outsubtext (inhalt, 1, 22 - length (prompt)); out (""" ")
    END IF
  END IF

END PROC fusszeile ausgeben;


(**************************** Menue 'Oeffnen' *****************************)

THESAURUS VAR zusaetzliche namen := empty thesaurus;

BOOL VAR
  nach aendern fragen,
  multi user manager eingestellt := FALSE;

TASK VAR multi user manager;

TEXT VAR
  manager taskname := niltext,
  herkunftszeichen := niltext;

LET
  p manager =  #1015#
    " Manager: ",
  keine sicherung noetig =  #1017#
    "Keine Sicherung noetig.",
  arbeitskopien loeschen =  #1018#
    "Interne Arbeitskopien loeschen",
  t arbeitskopie =  #1019#
    "Arbeitskopie ",
  t unveraendert =  #1020#
    " unveraendert.",
  t veraendert =  #1021#
    " veraendert! Sichern",
  alte version ueberschreiben =  #1022#
    "Alte Version ueberschreiben",
  unter dem namen =  #1023#
    "Sondern unter dem Namen:",
  ueberschreiben =  #1024#
    " ueberschreiben",
  sortierung wiederherstellen =  #1025#
    "Datei wieder sortieren",
  t notizen ansehen =  #1026#
    "Notizen",
  name task =  #1027#
    "Name Managertask:",
  task existiert nicht =  #1028#
    "Task existiert nicht !",
  wollen sie etwas veraendern =  #1029#
    "Wollen Sie etwas veraendern (eine Arbeitskopie anlegen)",
  markierungen geloescht =  #1030#
    "Alle Markierungen gelöscht.",
  t pruefbedingungen =  #1032#
    "Pruefbedingungen",
  felder aendern =  #1033#
    "Feldnamen oder Feldtypen aendern",
  t feldnamen anfuegen =  #1034#
    "Feldnamen anfuegen",
  neuer feldname =  #1035#
    "Neuer Feldname:",
  neuer typ =  #1036#
    "Neuer Typ (TEXT,DIN,ZAHL,DATUM):",
  neue feldnamen eingeben =  #1037#
    "Neue Feldnamen",
  id text =  #1038#
    "TEXT",
  id din =  #1039#
    "DIN",
  id zahl =  #1040#
    "ZAHL",
  id datum =  #1041#
    "DATUM",
  alte feldreihenfolge aendern =  #1042#
    "Alte Feldreihenfolge aendern",
  speicherengpass =  #1043#
    ""7"ACHTUNG: System voll, Dateien loeschen!";


PROC oeffnen interpreter (INT CONST wahl nr) :

  SELECT wahl nr OF
  CASE 0 : auf geschlossene datei pruefen
  CASE 1 : neue datei oeffnen
  CASE 2 : datei ketten
  CASE 3 : datei koppeln
  CASE 4 : aktuelle datei sichern
  CASE 5 : notizen editieren
  CASE 6 : feldstruktur aendern
  CASE 7 : pruefbedingungen aendern
  CASE 8 : multi user manager einstellen
  OTHERWISE ggf dialogfenster loeschen
  END SELECT;
  fusszeile ausgeben (p manager, manager taskname);
  storage kontrollieren;
  heap kontrollieren .

auf geschlossene datei pruefen :
  IF anzahl dateien = 0 THEN
    eudas interpreter (0, 0)
  END IF .

neue datei oeffnen :
  auf sicherung ueberpruefen;
  oeffnen im menue (TRUE);
  push (2) .

datei ketten :
  disable stop;
  manager pre;
  ausfuehrung (PROC (TEXT CONST) ketten, eudas typ);
  manager post;
  enable stop;
  ketten koppeln sperre .

datei koppeln :
  disable stop;
  manager pre;
  ausfuehrung (PROC (TEXT CONST) koppeln, eudas typ);
  manager post;
  enable stop;
  ketten koppeln sperre .

aktuelle datei sichern :
  IF aendern erlaubt THEN
    einzeldateien abfragen
  ELSE
    dialog; out (keine sicherung noetig);
    dateien aus manager loeschen
  END IF;
  sperre setzen .

einzeldateien abfragen :
  INT VAR datei nr;
  FOR datei nr FROM 1 UPTO anzahl dateien REP
    einzelsicherung (datei nr)
  END REP;
  IF ja (arbeitskopien loeschen, "JA/Dateien loeschen") THEN
    dateien aus manager zuruecksichern;
    dateien loeschen (TRUE)
  END IF .

sperre setzen :
  IF anzahl dateien = 0 THEN
    oeffnen sperre (FALSE);
    aendern sperre (FALSE)
  END IF;
  ketten koppeln sperre;
  fusszeile aufbauen .

dateien aus manager loeschen :
  INT CONST vorhandene dateien := anzahl dateien;
  dateien loeschen (FALSE);
  FOR datei nr FROM 1 UPTO vorhandene dateien REP
    IF manager herkunft (datei nr) THEN
      loeschen (eudas dateiname (datei nr))
    END IF
  END REP .

notizen editieren :
  notizen ansehen;
  dialogfenster loeschen .

feldstruktur aendern :
  zugriff (PROC (EUDAT VAR) feldstruktur) .

pruefbedingungen aendern :
  pruefbedingungen;
  dialogfenster loeschen .

multi user manager einstellen :
  manager taskname := "";
  fenster veraendert (fuss);
  editget (name task, manager taskname, "", "GET/multi task");
  IF manager taskname = "" THEN
    multi user manager eingestellt := FALSE
  ELIF exists (/manager taskname) THEN
    multi user manager := task (manager taskname);
    multi user manager eingestellt := TRUE
  ELSE
    multi user manager eingestellt := FALSE;
    manager taskname := "";
    errorstop (task existiert nicht)
  END IF .

heap kontrollieren :
  IF heap size - belegter heap > 4 THEN
    collect heap garbage;
    belegter heap := heap size
  END IF .

ggf dialogfenster loeschen :
  IF wahl nr = -1 THEN
    dialogfenster loeschen;
    fenster veraendert (fuss);
    LEAVE oeffnen interpreter
  END IF .

END PROC oeffnen interpreter;

PROC auf sicherung ueberpruefen :

  BOOL VAR notwendig := FALSE;
  IF aendern erlaubt THEN
    wirklich pruefen
  END IF;
  IF notwendig THEN dialog (* Leerzeile *) END IF .

wirklich pruefen :
  INT VAR datei nr;
  FOR datei nr FROM 1 UPTO anzahl dateien REP
    IF inhalt veraendert (datei nr) THEN
      einzelsicherung (datei nr);
      notwendig := TRUE;
      ggf last param korrigieren
    END IF
  END REP .

ggf last param korrigieren :
  IF datei nr = 1 CAND std = eudas dateiname (1) THEN
    last param (niltext)
  END IF .

END PROC auf sicherung ueberpruefen;

PROC einzelsicherung (INT CONST datei nr) :

  frage zusammenbauen;
  IF inhalt veraendert (datei nr) THEN
    IF ja (frage, "JA/sichere") THEN
      sicherung durchfuehren
    END IF
  ELSE
    dialog; out (frage)
  END IF .

frage zusammenbauen :
  TEXT VAR frage := t arbeitskopie;
  frage CAT textdarstellung (eudas dateiname (datei nr));
  IF inhalt veraendert (datei nr) THEN
    frage CAT t veraendert
  ELSE
    frage CAT t unveraendert
  END IF .

sicherung durchfuehren :
  TEXT VAR name := eudas dateiname (datei nr);
  IF ja (alte version ueberschreiben, "JA/alte version") THEN
    forget (name, quiet)
  ELIF manager herkunft (datei nr) THEN
    errorstop (niltext)
  ELSE
    neuen namen erfragen
  END IF;
  sichere (datei nr, name);
  eventuell sortierung wiederherstellen .

neuen namen erfragen :
  edit get (unter dem namen, name, "", "GET/Sicherungsname");
  IF exists (name) THEN
    eventuell ueberschreiben
  END IF .

eventuell ueberschreiben :
  IF ja (textdarstellung (name) + ueberschreiben, "JA/ueber") THEN
    forget (name, quiet)
  ELSE
    einzelsicherung (datei nr);
    LEAVE einzelsicherung
  END IF .

eventuell sortierung wiederherstellen :
  EUDAT VAR eudat;
  oeffne (eudat, name);
  IF war sortiert CAND soll sortiert werden THEN
    bitte warten;
    sortiere (eudat)
  END IF .

war sortiert :
  sortierreihenfolge (eudat) <> niltext CAND unsortierte saetze (eudat) > 0 .

soll sortiert werden :
  ja (sortierung wiederherstellen, "JA/Sicherungssortierung") .

END PROC einzelsicherung;

PROC oeffnen im menue (BOOL CONST aendern fragen) :

  IF aendern erlaubt THEN
    dateien aus manager zuruecksichern
  END IF;
  dateien loeschen (TRUE);
  oeffnen sperre (FALSE);
  aendern sperre (FALSE);
  forget (test ds);
  disable stop;
  manager pre;
  nach aendern fragen := aendern fragen;
  einzelausfuehrung (PROC (TEXT CONST) oeffnen, eudas typ);
  manager post;
  ketten koppeln sperre;
  enable stop;
  IF anzahl dateien > 0 THEN
    oeffnen sperre (TRUE);
    aendern sperre (aendern erlaubt)
  END IF

END PROC oeffnen im menue;

PROC manager pre :

  IF multi user manager eingestellt THEN
    zusaetzliche namen := ALL multi user manager
  END IF

END PROC manager pre;

PROC manager post :

  zusaetzliche namen := empty thesaurus;
  fusszeile aufbauen

END PROC manager post;

PROC dateien aus manager zuruecksichern :

  INT VAR datei nr;
  FOR datei nr FROM 1 UPTO anzahl dateien REP
    IF manager herkunft (datei nr) THEN
      save oder free an manager
    END IF
  END REP .

save oder free an manager :
  IF in manager ueberschreiben THEN
    disable stop;
    set command dialogue false;
    save (eudas dateiname (datei nr), multi user manager);
    reset command dialogue;
    enable stop;
    forget (eudas dateiname (datei nr), quiet)
  ELSE
    free (eudas dateiname (datei nr), multi user manager)
  END IF;
  herkunft eintragen (datei nr, FALSE) .

in manager ueberschreiben :
  exists (eudas dateiname (datei nr)) .

END PROC dateien aus manager zuruecksichern;

PROC multi datei loeschen :

  IF manager herkunft (anzahl dateien) AND aendern erlaubt THEN
    forget (eudas dateiname (anzahl dateien), quiet)
  END IF

END PROC multi datei loeschen;

PROC oeffnen (TEXT CONST dateiname) :

  BOOL VAR auch aendern;
  eventuell neu einrichten;
  oeffne (dateiname, auch aendern);
  multi datei loeschen .

eventuell neu einrichten :
  IF datei existiert nicht AND nach aendern fragen THEN
    frage ob einrichten (dateiname);
    EUDAT VAR eudat;
    oeffne (eudat, dateiname);
    feldstruktur (eudat);
    auch aendern := TRUE
  ELSE
    auch aendern :=
      nach aendern fragen CAND ja (wollen sie etwas veraendern, "JA/oeffne");
    aus manager besorgen (dateiname, auch aendern)
  END IF .

datei existiert nicht :
  NOT exists (dateiname) AND NOT (zusaetzliche namen CONTAINS dateiname) .

END PROC oeffnen;

PROC ketten (TEXT CONST dateiname) :

  aus manager besorgen (dateiname, aendern erlaubt);
  kette (dateiname);
  multi datei loeschen

END PROC ketten;

PROC koppeln (TEXT CONST dateiname) :

  aus manager besorgen (dateiname, aendern erlaubt);
  kopple (dateiname);
  multi datei loeschen

END PROC koppeln;

PROC aus manager besorgen (TEXT CONST dateiname, BOOL CONST mit lock) :

  BOOL VAR herkunft := FALSE;
  IF multi user manager eingestellt THEN
    manager abfragen
  END IF;
  herkunft eintragen (anzahl dateien + 1, herkunft) .

manager abfragen :
  IF (zusaetzliche namen CONTAINS dateiname) CAND
    (NOT exists (dateiname) COR eigene datei ueberschreiben) THEN
    IF mit lock THEN
      lock (dateiname, multi user manager)
    END IF;
    forget (dateiname, quiet);
    fetch (dateiname, multi user manager);
    herkunft := TRUE
  END IF .

eigene datei ueberschreiben :
  ja (textdarstellung (dateiname) + t im system ueberschreiben, "JA/fetch") .

END PROC aus manager besorgen;

PROC herkunft eintragen (INT CONST dateiindex, BOOL CONST herkunft) :

  WHILE length (herkunftszeichen) < dateiindex REP
    herkunftszeichen CAT blank
  END REP;
  replace (herkunftszeichen, dateiindex, entsprechendes zeichen) .

entsprechendes zeichen :
  IF herkunft THEN
    "-"
  ELSE
    blank
  END IF .

END PROC herkunft eintragen;

BOOL PROC manager herkunft (INT CONST dateiindex) :

  IF length (herkunftszeichen) < dateiindex THEN
    FALSE
  ELSE
    (herkunftszeichen SUB dateiindex) <> blank
  END IF

END PROC manager herkunft;

PROC notizen ansehen :

  notizen lesen (3, feldpuffer);
  DATASPACE VAR ds := nilspace;
  FILE VAR f := sequential file (output, ds);
  disable stop;
  headline (f, t notizen ansehen);
  notizen anbieten (f, feldpuffer, ganz, "EDIT/Notizen");
  forget (ds);
  enable stop;
  IF aendern erlaubt THEN
    notizen aendern (3, feldpuffer)
  END IF

END PROC notizen ansehen;

PROC notizen anbieten (FILE VAR f, TEXT VAR puffer,
                       FENSTER CONST edit fenster, TEXT CONST hilfsname) :

  LET trennzeichen = "#-#";
  enable stop;
  notizen in datei;
  datei editieren;
  notizen aus datei .

notizen in datei :
  INT VAR
    von := 1,
    bis;
  REP
    bis := pos (puffer, trennzeichen, von);
    IF bis = 0 THEN
      putline (f, subtext (puffer, von))
    ELSE
      putline (f, subtext (puffer, von, bis - 1))
    END IF;
    von := bis + 3
  UNTIL bis = 0 OR von > length (puffer) END REP .

datei editieren :
  modify (f);
  edit (f, edit fenster, hilfsname, TRUE) .

notizen aus datei :
  TEXT VAR zeile;
  puffer := niltext;
  input (f);
  WHILE NOT eof (f) REP
    getline (f, zeile);
    blank entfernen;
    puffer CAT zeile;
    puffer CAT trennzeichen
  END REP .

blank entfernen :
  IF (zeile SUB length (zeile)) = blank THEN
    zeile := subtext (zeile, 1, length (zeile) - 1)
  END IF .

END PROC notizen anbieten;

PROC feldstruktur (EUDAT VAR eudat) :

  SATZ VAR satz;
  feldnamen lesen (eudat, satz);
  IF feldnamen anfuegen THEN
    feldnamen editieren
  END IF;
  IF ja (felder aendern, "JA/Feldaendern") THEN
    auswahl zu aendernder felder
  END IF .

feldnamen anfuegen :
  IF felderzahl (satz) > 0 THEN
    ja (t feldnamen anfuegen, "JA/feldnamen") 
  ELSE
    TRUE
  END IF .

feldnamen editieren :
  DATASPACE VAR ds := nilspace;
  FILE VAR f := sequential file (output, ds);
  disable stop;
  feldnamen anbieten (f, satz);
  forget (ds);
  enable stop;
  feldnamen aendern (eudat, satz) .

auswahl zu aendernder felder :
  feldtypen dazuschreiben;
  auswahl anbieten ("EUDAS-Felder", rechts, "AUSWAHL/Felder",
                     PROC (TEXT VAR, INT CONST) aus sammel);
  INT VAR feldnr := 1;
  WHILE wahl (feldnr) > 0 REP
    ein feld aendern;
    feldnr INCR 1
  END REP;
  feldnamen aendern (eudat, satz) .

feldtypen dazuschreiben :
  satz initialisieren (sammel);
  FOR feldnr FROM 1 UPTO felderzahl (satz) REP
    feld lesen (satz, feldnr, feldpuffer);
    feld aendern (sammel, feldnr, info + textdarstellung (feldpuffer))
  END REP .

info :
  "(" + typtext (feldinfo (eudat, feldnr)) + ") " .

ein feld aendern :
  TEXT VAR feldname;
  feld lesen (satz, wahl (feldnr), feldname);
  editget (neuer feldname, feldname, "", "GET/feldname");
  feld aendern (satz, wahl (feldnr), feldname);
  TEXT VAR typ := typtext (feldinfo (eudat, wahl (feldnr)));
  REP
    editget (neuer typ, typ, "", "GET/feldtyp")
  UNTIL texttyp (typ) >= -1 END REP;
  feldinfo (eudat, wahl (feldnr), texttyp (typ)) .

END PROC feldstruktur;

PROC pruefbedingungen :

  enable stop;
  DATASPACE VAR ds := nilspace;
  FILE VAR f := sequential file (output, ds);
  headline (f, t pruefbedingungen);
  notizen lesen (1, feldpuffer);
  disable stop;
  notizen anbieten (f, feldpuffer, ganz, "EDIT/Pruefbed");
  forget (ds);
  enable stop;
  IF aendern erlaubt THEN
    notizen aendern (1, feldpuffer)
  END IF .

END PROC pruefbedingungen;

PROC feldnamen anbieten (FILE VAR f, SATZ VAR satz) :

  enable stop;
  neue namen editieren;
  neue namen zurueckschreiben .

neue namen editieren :
  modify (f);
  headline (f, neue feldnamen eingeben);
  edit (f, rechts, "EDIT/Feldnamen", TRUE) .

neue namen zurueckschreiben :
  INT VAR feldnr := felderzahl (satz);
  input (f);
  WHILE NOT eof (f) REP
    getline (f, feldpuffer);
    blank entfernen;
    feldnr INCR 1;
    feld aendern (satz, feldnr, feldpuffer)
  END REP .

blank entfernen :
  IF (feldpuffer SUB length (feldpuffer)) = blank THEN
    feldpuffer := subtext (feldpuffer, 1, length (feldpuffer) - 1)
  END IF .

END PROC feldnamen anbieten;

TEXT PROC typtext (INT CONST typ) :

  SELECT typ + 1 OF
  CASE 0 : id text
  CASE 1 : id din
  CASE 2 : id zahl
  CASE 3 : id datum
  OTHERWISE niltext
  END SELECT

END PROC typtext;

INT PROC texttyp (TEXT CONST t) :

  IF t = id text THEN -1
  ELIF t = id din THEN 0
  ELIF t = id zahl THEN 1
  ELIF t = id datum THEN 2
  ELSE -2
  END IF

END PROC texttyp;

PROC storage kontrollieren :

  INT VAR size, used;
  storage (size, used);
  IF used > size THEN
    neuer dialog; dialog;
    out (speicherengpass)
  END IF

END PROC storage kontrollieren;


(************************* Menue 'Einzelsatz' *****************************)

BOOL VAR
  satz leer,
  umgeschaltet aus einfuegen := FALSE,
  umgeschaltet aus aendern := FALSE;

LET
  aendern status =  #1044#
"SATZ AENDERN:    Abbruch: ESC h    Beenden: ESC q    Hilfe: ESC ?",
  einfuegen status =  #1045#
"SATZ EINFUEGEN:    Abbruch: ESC h    Beenden: ESC q    Hilfe: ESC ?",
  suchen status =  #1046#
"SUCHMUSTER EINGEBEN:    Abbruch: ESC h    Beenden: ESC q    Hilfe: ESC ?",
  umschalten auf =  #1047#
    "Umschalten auf Koppeldatei ",
  koppelfelder uebernehmen =  #1048#
    "Koppelfelder uebernehmen",
  ungueltige satznummer =  #1049#
    "Ungueltige Satznummer",
  neue satznummer =  #1050#
    "Neue Satznummer:",
  t bitte warten =  #1051#
    " Bitte warten.. ",
  wzk =  #1052#
    "wzK",
  wz =  #1053#
    "wz";

LET
  blanks unten links = ""6""23""0"              :",
  blanks unten ganz  = ""6""23""0"              :"5"";


PROC anzeigen interpreter (INT CONST wahl nr) :

  SELECT wahl nr OF
  CASE 0 : anzeige einschalten
  CASE 1 : einen satz weiter
  CASE 2 : einen satz zurueck
  CASE 3 : direkt auf satz
  CASE 4 : saetze auswaehlen
  CASE 5 : auswahlbedingung loeschen
  CASE 6 : aktuelle markierung aendern
  CASE 7 : neuen satz einfuegen
  CASE 8 : aktuellen satz aendern
  CASE 9 : einzelsatz tragen
  CASE 10: einzelsatz holen
  CASE 11: felder auswaehlen
  CASE 12: esc oben
  CASE 13: esc unten
  CASE 14: esc 1
  CASE 15: esc 9
  CASE 16: esc k
  OTHERWISE anzeige update
  END SELECT;
  storage kontrollieren .

anzeige einschalten :
  exit zeichen (wz) .

einen satz weiter :
  bitte warten;
  weiter (2);
  bild ausgeben (FALSE) .

einen satz zurueck :
  bitte warten;
  zurueck (2);
  bild ausgeben (FALSE) .

saetze auswaehlen :
  suchen;
  bild ausgeben (TRUE) .

auswahlbedingung loeschen :
  suchbedingung loeschen;
  bild ausgeben (FALSE) .

direkt auf satz :
  TEXT VAR nr := niltext;
  fusszeile ganz loeschen;
  editget (neue satznummer, nr, "", "GET/auf satz");
  INT CONST ziel := int (nr);
  IF nr = niltext THEN
    bild ausgeben (FALSE)
  ELIF last conversion ok THEN
    auf satz (ziel);
    bild ausgeben (FALSE)
  ELSE
    errorstop (ungueltige satznummer)
  END IF .

neuen satz einfuegen :
  einfuegen;
  bild ausgeben (TRUE) .

aktuellen satz aendern :
  aendern;
  bild ausgeben (TRUE) .

aktuelle markierung aendern :
  markierung aendern;
  bild ausgeben (FALSE) .

einzelsatz tragen :
  last param darf nicht geoeffnet sein;
  fusszeile ganz loeschen;
  dateinamen anfordern (name der zieldatei);
  einzelausfuehrung (PROC (TEXT CONST) trage satz und frage, eudas typ);
  bild ausgeben (TRUE) .

einzelsatz holen :
  last param darf nicht geoeffnet sein;
  fusszeile ganz loeschen;
  dateinamen anfordern (name der quelldatei);
  einzelausfuehrung (PROC (TEXT CONST) hole satz, eudas typ);
  bild ausgeben (TRUE) .

felder auswaehlen :
  TEXT VAR wahlvektor;
  fusszeile ganz loeschen;
  felder waehlen lassen (wahlvektor);
  IF wahlvektor <> niltext THEN
    feldauswahl (wahlvektor)
  END IF;
  bild ausgeben (TRUE) .

esc oben :
  rollcursor;
  rollen (-23);
  IF anzahl dateien > 0 THEN
    bild ausgeben (FALSE)
  END IF .

esc unten :
  rollcursor;
  rollen (23);
  IF anzahl dateien > 0 THEN
    bild ausgeben (FALSE)
  END IF .

esc 1 :
  rollcursor;
  rollen (-9999);
  IF anzahl dateien > 0 THEN
    bild ausgeben (FALSE)
  END IF .

esc 9 :
  rollcursor;
  rollen (9999);
  IF anzahl dateien > 0 THEN
    bild ausgeben (FALSE)
  END IF .

esc k :
  IF auf koppeldatei THEN
    zurueckschalten
  ELSE
    auf koppeldatei umschalten
  END IF;
  IF anzahl dateien > 0 THEN
    bild ausgeben (TRUE)
  END IF .

zurueckschalten :
  IF (umgeschaltet aus aendern OR umgeschaltet aus einfuegen) THEN
    fragen ob koppelfelder uebernehmen;
    wieder in alte operation
  ELSE
    auf koppeldatei (0)
  END IF;
  ketten koppeln sperre .

fragen ob koppelfelder uebernehmen :
  fusszeile ganz loeschen;
  IF NOT dateiende CAND ja (koppelfelder uebernehmen, "JA/uebernehmen") THEN
    auf koppeldatei (1)
  ELSE
    auf koppeldatei (0)
  END IF .

wieder in alte operation :
  umgeschaltet aus einfuegen := FALSE;
  IF umgeschaltet aus aendern THEN
    umgeschaltet aus aendern := FALSE;
    aendern
  ELSE
    einfuegen intern (TRUE)
  END IF .

anzeige update :
  IF wahl nr = -2 THEN
    IF anzahl dateien > 0 THEN
      fusszeile links loeschen;
      bild ausgeben (FALSE)
    ELSE
      fusszeile ganz loeschen
    END IF
  ELSE
    dialogfenster loeschen;
    fenster veraendert (fuss)
  END IF .

fusszeile links loeschen :
  out (blanks unten links) .

fusszeile ganz loeschen :
  out (blanks unten ganz) .

END PROC anzeigen interpreter;

PROC suchen :

  disable stop;
  exit zeichen ("");
  status anzeigen (suchen status);
  suchen (PROC suchen hilfe);
  exit zeichen (wz)

END PROC suchen;

PROC suchen hilfe :

  hilfe anbieten ("EDIT/Suchen", rechts)

END PROC suchen hilfe;

PROC bitte warten :

  status anzeigen (t bitte warten)

END PROC bitte warten;

PROC einfuegen :

  einfuegen intern (FALSE)

END PROC einfuegen;

PROC einfuegen intern (BOOL CONST nach umschalten) :

  BOOL VAR weiter aendern := nach umschalten;
  exit zeichen setzen;
  REP
    status anzeigen (einfuegen status);
    IF weiter aendern THEN
      aendern (PROC einfuegen hilfe);
      weiter aendern := FALSE
    ELSE
      einfuegen (PROC einfuegen hilfe)
    END IF;
    satz untersuchen;
    exit zeichen bei einfuegen behandeln
  END REP .

exit zeichen bei einfuegen behandeln :
  SELECT pos (wzk, exit durch) OF
  CASE 0 : IF satz leer THEN
             satz loeschen
           END IF;
           LEAVE einfuegen intern
  CASE 1 : IF satz leer THEN
             satz loeschen
           ELSE
             bitte warten; weiter (2)
           END IF
  CASE 2 : IF satz leer THEN
             satz loeschen
           ELSE
             bitte warten; zurueck (2)
           END IF
  CASE 3 : auf koppeldatei umschalten;
           IF auf koppeldatei THEN
             umgeschaltet aus einfuegen := TRUE;
             LEAVE einfuegen intern
           END IF;
           weiter aendern := TRUE
  END SELECT .

END PROC einfuegen intern;

PROC einfuegen hilfe :

  hilfe anbieten ("EDIT/Einfuegen", rechts)

END PROC einfuegen hilfe;

PROC exit zeichen setzen :

  IF anzahl koppeldateien > 0 AND NOT auf koppeldatei THEN
    exit zeichen (wzk)
  ELSE
    exit zeichen (wz)
  END IF

END PROC exit zeichen setzen;

PROC aendern :

  exit zeichen setzen;
  kommando auf taste legen ("F", "prueffehler editieren");
  REP
    status anzeigen (aendern status);
    aendern (PROC aendern hilfe);
    satz untersuchen;
    exit zeichen bei aendern behandeln
  END REP .

exit zeichen bei aendern behandeln :
  SELECT pos (wzk, exit durch) OF
  CASE 0 : IF satz leer THEN
             satz loeschen
           END IF;
           LEAVE aendern
  CASE 1 : IF satz leer THEN
             satz loeschen
           ELSE
             bitte warten; weiter (2)
           END IF
  CASE 2 : IF satz leer THEN
             satz loeschen
           ELSE
             bitte warten; zurueck (2)
           END IF
  CASE 3 : auf koppeldatei umschalten;
           IF auf koppeldatei THEN
             umgeschaltet aus aendern := TRUE;
             LEAVE aendern
           END IF
  END SELECT .

END PROC aendern;

PROC aendern hilfe :

  hilfe anbieten ("EDIT/Aendern", rechts)

END PROC aendern hilfe;

PROC prueffehler editieren :

  IF test version = datei version THEN
    modify (test file);
    edit (test file)
  END IF

END PROC prueffehler editieren;

PROC auf koppeldatei umschalten :

  INT VAR datei nr := folgedatei (0);
  WHILE datei nr > 0 REP
    out (blanks unten ganz);
    IF auf diese datei schalten THEN
      auf koppeldatei (datei nr);
      ketten koppeln sperre;
      LEAVE auf koppeldatei umschalten
    END IF;
    datei nr := folgedatei (datei nr)
  END REP .

auf diese datei schalten :
  ja (umschalten auf + textdarstellung (eudas dateiname (datei nr)),
      "JA/umschalten") .

END PROC auf koppeldatei umschalten;

PROC zeilenrest ausgeben (TEXT CONST zeile, INT CONST dummy) :

  outsubtext (zeile, anfang); out (cleol) .

anfang :
  pos (zeile, blank, 6) + 1 + dummy - dummy .

END PROC zeilenrest ausgeben;

PROC satz untersuchen :

  feld bearbeiten (1, PROC (TEXT CONST, INT CONST, INT CONST) ob leer)

END PROC satz untersuchen;

PROC ob leer (TEXT CONST satz, INT CONST von, bis) :

  satz leer := von < 3 OR von > length (satz) + bis - bis

END PROC ob leer;

PROC rollcursor :

  cursor (15, 24)

END PROC rollcursor;

PROC trage satz und frage (TEXT CONST dateiname) :

  IF exists (dateiname) THEN
    teste auf offen
  ELSE
    frage ob einrichten (dateiname)
  END IF;
  bitte warten;
  trage satz (dateiname) .

teste auf offen :
  IF index der arbeitskopie (dateiname) <> 0 THEN
    errorstop (nicht in offene datei)
  END IF .

END PROC trage satz und frage;

PROC felder waehlen lassen (TEXT VAR wahlvektor) :

  auswahl anbieten ("EUDAS-Anzeigefelder", rechts, "AUSWAHL/Anzeigefelder",
                    PROC (TEXT VAR, INT CONST) gib namen);
  wahlvektor := niltext;
  INT VAR nr := 1;
  WHILE wahl (nr) > 0 REP
    wahlvektor CAT code (wahl (nr));
    nr INCR 1
  END REP

END PROC felder waehlen lassen;


(************************* Menue 'Gesamtdatei' ***************************)

LET
  felder auswaehlen =  #1054#
    "Angezeigte Felder auswaehlen",
  aufsteigend sortieren =  #1055#
    " aufsteigend sortieren";

DATASPACE VAR
  kopier ds;


PROC bearbeiten interpreter (INT CONST wahl nr) :

  SELECT wahl nr OF
  CASE 1 : saetze kopieren
  CASE 2 : saetze tragen
  CASE 3 : nach vorschrift aendern
  CASE 4 : uebersicht ausgeben
  CASE 5 : datei sortieren
  CASE 6 : alle markierungen loeschen
  OTHERWISE ggf dialogfenster loeschen
  END SELECT;
  storage kontrollieren .

saetze tragen :
  last param darf nicht geoeffnet sein;
  dateinamen anfordern (name der zieldatei);
  einzelausfuehrung (PROC (TEXT CONST) trage saetze, eudas typ) .

saetze kopieren :
  last param darf nicht geoeffnet sein;
  dateinamen anfordern (name der zieldatei);
  einzelausfuehrung (PROC (TEXT CONST) kopiere saetze, eudas typ);
  dialogfenster loeschen;
  fusszeile ausgeben ("", "") .

nach vorschrift aendern :
  dateinamen anfordern (name der verarbeitungsvorschrift);
  ausfuehrung (PROC (TEXT CONST) verarbeite mit edit, file typ);
  dialogfenster loeschen;
  fusszeile ausgeben ("", "") .

uebersicht ausgeben :
  TEXT VAR uebersichtsauswahl;
  feldauswahl fuer uebersicht (uebersichtsauswahl);
  uebersicht (uebersichtsauswahl, PROC uebersicht hilfe);
  dialogfenster loeschen;
  fusszeile ausgeben ("", "") .

datei sortieren :
  zugriff (PROC (EUDAT VAR) einzelsortiere) .

alle markierungen loeschen :
  markierungen loeschen;
  dialog; out (markierungen geloescht) .

ggf dialogfenster loeschen :
  IF wahl nr = -1 THEN
    dialogfenster loeschen;
    fenster veraendert (fuss)
  ELIF wahl nr = -2 THEN
    fusszeile ausgeben ("", "")
  END IF .

END PROC bearbeiten interpreter;

PROC last param darf nicht geoeffnet sein :

  IF index der arbeitskopie (std) <> 0 THEN
    last param (niltext)
  END IF

END PROC last param darf nicht geoeffnet sein;

PROC trage saetze (TEXT CONST dateiname) :

  BOOL VAR mit test;
  IF exists (dateiname) THEN
    teste auf offen;
    frage ob testen
  ELSE
    frage ob einrichten (dateiname);
    mit test := FALSE
  END IF;
  BOOL CONST mit sortieren := ja (sortierfrage, "JA/sortieren");
  bitte warten;
  ggf datei initialisieren;
  trage (dateiname, test file, mit test);
  fehlerzahl ausgeben;
  IF mit sortieren THEN
    EUDAT VAR eudat;
    oeffne (eudat, dateiname);
    sortiere (eudat)
  END IF .

teste auf offen :
  IF index der arbeitskopie (dateiname) <> 0 THEN
    errorstop (nicht in offene datei)
  END IF .

frage ob testen :
  mit test := ja (pruefbedingungen testen, "JA/testen") .

ggf datei initialisieren :
  IF mit test THEN
    forget (test ds);
    test ds := nilspace;
    test file := sequential file (output, test ds);
    test version := datei version
  ELSE
    forget (test ds);
    test version := datei version - 1
  END IF .

fehlerzahl ausgeben :
  IF mit test CAND lines (test file) > 0 THEN
    dialog; put (lines (test file));
    put (prueffehler festgestellt)
  END IF .

END PROC trage saetze;

PROC verarbeite mit edit (TEXT CONST dateiname) :

  IF NOT exists (dateiname) THEN
    edit unten (dateiname, "EDIT/Verarbeite")
  END IF;
  bild frei fuer uebersetzung;
  FILE VAR f := sequential file (input, dateiname);
  disable stop;
  verarbeite (f);
  uebersetzungsfehler behandeln .

END PROC verarbeite mit edit;

PROC feldauswahl fuer uebersicht (TEXT VAR uebersichtsauswahl) :

  uebersichtsauswahl := niltext;
  IF ja (felder auswaehlen, "JA/Ub.Felder") THEN
    felder waehlen lassen (uebersichtsauswahl)
  END IF

END PROC feldauswahl fuer uebersicht;

PROC uebersicht hilfe :

  hilfe anbieten ("UEBERSICHT", ganz)

END PROC uebersicht hilfe;

PROC kopiere saetze (TEXT CONST dateiname) :

  disable stop;
  kopier ds := nilspace;
  kopiere saetze intern (dateiname);
  forget (kopier ds)

END PROC kopiere saetze;

PROC kopiere saetze intern (TEXT CONST dateiname) :

  TEXT VAR mustername := "";
  FILE VAR f;
  EUDAT VAR eudat;
  BOOL VAR mit sortieren := FALSE;

  enable stop;
  IF exists (dateiname) THEN
    teste auf offen und sortieren
  ELSE
    frage ob einrichten (dateiname)
  END IF;
  editget (name kopiermuster, mustername, "", "GET/kopiermuster");
  IF exists (mustername) THEN
    f := sequential file (input, mustername)
  ELSE
    ggf kopiermuster einrichten;
    std kopiermuster (dateiname, f)
  END IF;
  modify (f);
  wirklich kopieren;
  ggf sortieren .

teste auf offen und sortieren :
  IF index der arbeitskopie (dateiname) <> 0 THEN
    errorstop (nicht in offene datei)
  END IF;
  oeffne (eudat, dateiname);
  IF sortierreihenfolge (eudat) <> niltext THEN
    mit sortieren := ja (sortierfrage, "JA/sortieren")
  END IF .

ggf kopiermuster einrichten :
  IF mustername = niltext THEN
    f := sequential file (output, kopier ds)
  ELSE
    frage ob einrichten (mustername);
    f := sequential file (output, mustername)
  END IF .

wirklich kopieren :
  edit (f, ganz, "EDIT/Kopiermuster", TRUE);
  bild frei fuer uebersetzung;
  kopiere (dateiname, f) .

ggf sortieren :
  IF mit sortieren THEN
    oeffne (eudat, dateiname);
    sortiere (eudat)
  END IF .

END PROC kopiere saetze intern;

INT PROC index der arbeitskopie (TEXT CONST dateiname) :

  INT VAR dateinr;
  FOR dateinr FROM 1 UPTO anzahl dateien REP
    IF eudas dateiname (dateinr) = dateiname THEN
      LEAVE index der arbeitskopie WITH dateinr
    END IF
  END REP;
  0

END PROC index der arbeitskopie;

PROC edit unten (TEXT CONST dateiname, hilfe) :

  IF NOT exists (dateiname) THEN
    frage ob einrichten (dateiname)
  END IF;
  FILE VAR f := sequential file (modify, dateiname);
  edit (f, ganz, hilfe, TRUE)

END PROC edit unten;

PROC bild frei fuer uebersetzung :

  bitte warten;
  cursor (1, 2);
  out (cl eop);
  bildschirm neu

END PROC bild frei fuer uebersetzung;

PROC einzelsortiere (EUDAT VAR eudat) :

  TEXT VAR reihenfolge := sortierreihenfolge (eudat);
  IF reihenfolge = niltext COR alte reihenfolge aendern THEN
    sortierreihenfolge aendern;
    bitte warten;
    sortiere (eudat, reihenfolge)
  ELSE
    bitte warten;
    sortiere (eudat)
  END IF .

alte reihenfolge aendern :
  ja (alte feldreihenfolge aendern, "JA/Sortierfelder") .

sortierreihenfolge aendern :
  feldnamen lesen (eudat, sammel);
  auswahl anbieten ("EUDAS-Sortierfelder", rechts, "AUSWAHL/Sortierfelder",
                    PROC (TEXT VAR, INT CONST) aus sammel);
  INT VAR feldnr := 1;
  reihenfolge := niltext;
  WHILE wahl (feldnr) <> 0 REP
    reihenfolge CAT code (wahl (feldnr));
    nach richtung fragen;
    feldnr INCR 1
  END REP .

nach richtung fragen :
  feld lesen (sammel, wahl (feldnr), feldpuffer);
  IF ja (textdarstellung (feldpuffer) + aufsteigend sortieren,
         "JA/Sortierrichtung") THEN
    reihenfolge CAT "+"
  ELSE
    reihenfolge CAT "-"
  END IF .

END PROC einzelsortiere;

PROC gib namen (TEXT VAR name, INT CONST nr) :

  IF nr <= anzahl felder THEN
    feldnamen lesen (nr, name)
  ELSE
    name := niltext
  END IF

END PROC gib namen;


(************************* Menue 'Drucken' ********************************)

LET
  direkt ausgabe =  #1056#
    "Ausgabe automatisch zum Drucker",
  in bestimmte datei =  #1057#
    "Ausgabe in bestimmte Datei",
  name druckzieldatei =  #1058#
    "Name Ausgabedatei:",
  sortierfrage =  #1059#
    "Zieldatei anschliessend sortieren",
  pruefbedingungen testen =  #1060#
    "Pruefbedingungen testen",
  prueffehler festgestellt =  #1061#
    "Prueffehler festgestellt",
  nicht in offene datei =  #1062#
    "Zieldatei darf nicht geoeffnet sein",
  name kopiermuster =  #1063#
    "Name Kopiermuster (RET=Std):";

LET
  z form =  #1093#
    " zeilenweise formatieren",
  s form =  #1094#
    " seitenweise formatieren";

BOOL VAR
  zeilen automatisch := FALSE,
  seiten automatisch := FALSE;


PROC drucken interpreter (INT CONST wahl nr) :

  SELECT wahl nr OF
  CASE 1 : nach muster drucken
  CASE 2 : ausgaberichtung umschalten
  CASE 3 : musterdatei aendern
  CASE 4 : textdatei drucken
  CASE 5 : nachbearbeiten
  OTHERWISE ggf dialogfenster loeschen
  END SELECT;
  storage kontrollieren .

nach muster drucken :
  dateinamen anfordern (name des druckmusters);
  ausfuehrung (PROC (TEXT CONST) drucke mit edit, file typ);
  dialogfenster loeschen;
  fusszeile ausgeben ("", "") .

ausgaberichtung umschalten :
  direkt drucken (ja (direktausgabe, "JA/direkt drucken"));
  IF NOT direkt drucken CAND ja (in bestimmte datei, "JA/Druckdatei") THEN
    TEXT VAR dateiname := niltext;
    editget (name druckzieldatei, dateiname, "", "GET/Druckdatei");
    IF dateiname <> niltext THEN
      druckdatei (dateiname)
    END IF
  END IF .

musterdatei aendern :
  ausfuehrung (PROC (TEXT CONST) muster edit, file typ);
  dialogfenster loeschen;
  fusszeile ausgeben ("", "") .

textdatei drucken :
  ausfuehrung (PROC (TEXT CONST) print, file typ) .

nachbearbeiten :
  ausfuehrung (PROC (TEXT CONST) nachbearbeitung, file typ);
  dialogfenster loeschen;
  fusszeile ausgeben ("", "") .

ggf dialogfenster loeschen :
  IF wahl nr = -1 THEN
    dialogfenster loeschen;
    fenster veraendert (fuss)
  ELIF wahl nr = -2 THEN
    fusszeile ausgeben ("", "")
  END IF .

END PROC drucken interpreter;

PROC uebersetzungsfehler behandeln :

  IF uebersetzungsfehler THEN
    clear error
  END IF .

uebersetzungsfehler :
  is error CAND errormessage = niltext .

END PROC uebersetzungsfehler behandeln;

PROC drucke mit edit (TEXT CONST dateiname) :

  IF NOT exists (dateiname) THEN
    muster edit (dateiname)
  END IF;
  bild frei fuer uebersetzung;
  disable stop;
  drucke (dateiname);
  uebersetzungsfehler behandeln

END PROC drucke mit edit;

PROC muster edit (TEXT CONST dateiname) :

  edit unten (dateiname, "EDIT/Druckmuster")
 
END PROC muster edit;

PROC print (TEXT CONST dateiname) :

  do ("print (" + textdarstellung (dateiname) + ")")

END PROC print;

PROC nachbearbeitung (TEXT CONST dateiname) :

  IF ja (textdarstellung (dateiname) + z form, "JA/zeilenform") THEN
    zeilen formatieren
  END IF;
  IF ja (textdarstellung (dateiname) + s form, "JA/seitenform") THEN
    seiten formatieren
  END IF .

zeilen formatieren :
  IF zeilen automatisch THEN
    autoform (dateiname)
  ELSE
    lineform (dateiname)
  END IF;
  page;
  bildschirm neu .

seiten formatieren :
  IF seiten automatisch THEN
    autopageform (dateiname)
  ELSE
    pageform (dateiname)
  END IF;
  bildschirm neu .

END PROC nachbearbeitung;

PROC formatieren automatisch (BOOL CONST za, sa) :

  zeilen automatisch := za;
  seiten automatisch := sa

END PROC formatieren automatisch;


(********************** Menue 'Dateien' ***********************************)

TEXT VAR arbeitsbereich;

LET
  p task =  #1064#
    " Task: ",
  t neuer name =  #1065#
    "Neuer Name:",
  t zieldatei =  #1066#
    "Zieldatei:",
  t belegt =  #1067#
    " belegt ",
  t kb =  #1068#
    "KB.",
  t existiert nicht =  #1069#
    " existiert nicht.",
  t loeschen =  #1070#
    " im dieser Task loeschen",
  t neu einrichten =  #1071#
    " neu einrichten";


PROC dateiverwaltung (INT CONST wahl nr) :

  enable stop;
  SELECT wahl nr OF
  CASE 0 : arbeitsbereich bestimmen
  CASE 1 : dateiuebersicht
  CASE 2 : datei loeschen
  CASE 3 : datei umbenennen
  CASE 4 : datei kopieren
  CASE 5 : speicherbelegung datei
  CASE 6 : datei reorganisieren
  OTHERWISE ggf dialogfenster loeschen
  END SELECT;
  storage kontrollieren .

arbeitsbereich bestimmen :
  arbeitsbereich := name (myself) .

datei reorganisieren :
  ausfuehrung (PROC (TEXT CONST) aufraeumen, 0) .

datei umbenennen :
  ausfuehrung (PROC (TEXT CONST) umbenennen, 0) .

datei loeschen :
  ausfuehrung (PROC (TEXT CONST) loeschen, 0) .

dateiuebersicht :
  disable stop;
  DATASPACE VAR list ds := nilspace;
  FILE VAR f := sequential file (output, list ds);
  list (f);
  IF NOT is error THEN
    edit (f, rechts, "SHOW/Uebersicht", FALSE)
  END IF;
  forget (list ds);
  enable stop;
  tastenpuffer loeschen .

datei kopieren :
  ausfuehrung (PROC (TEXT CONST) ds kopieren, 0) .

speicherbelegung datei :
  ausfuehrung (PROC (TEXT CONST) speicherbelegung, 0) .

ggf dialogfenster loeschen :
  IF wahl nr = -1 THEN
    dialogfenster loeschen;
    fenster veraendert (fuss)
  ELIF wahl nr = -2 THEN
    fusszeile ausgeben (p task, arbeitsbereich)
  END IF .

END PROC dateiverwaltung;

PROC tastenpuffer loeschen :

  WHILE getcharety <> niltext REP END REP

END PROC tastenpuffer loeschen;

PROC aufraeumen (TEXT CONST dateiname) :

  IF type (old (dateiname)) = eudas typ THEN
    reorganisiere (dateiname)
  ELSE
    reorganize (dateiname)
  END IF

END PROC aufraeumen;

PROC umbenennen (TEXT CONST dateiname) :

  TEXT VAR neuer name := dateiname;
  IF exists (dateiname) THEN
    editget (t neuer name, neuer name, "", "GET/rename")
  END IF;
  rename (dateiname, neuer name)

END PROC umbenennen;

PROC loeschen (TEXT CONST dateiname) :

  IF offene datei THEN
    errorstop (nicht in offene datei)
  ELIF exists (dateiname) CAND frage bejaht THEN
    forget (dateiname, quiet)
  END IF .

offene datei :
  index der arbeitskopie (dateiname) <> 0 .

frage bejaht :
  ja (textdarstellung (dateiname) + t loeschen, "JA/forget") .

END PROC loeschen;

PROC ds kopieren (TEXT CONST dateiname) :

  TEXT VAR zieldatei := niltext;
  editget (t zieldatei, zieldatei, "", "GET/copy");
  copy (dateiname, zieldatei)

END PROC ds kopieren;

PROC speicherbelegung (TEXT CONST dateiname) :

  dialog; 
  out (textdarstellung (dateiname));
  IF exists (dateiname) THEN
    out (t belegt);
    put (ds pages (old (dateiname)) DIV 2);
    out (t kb)
  ELSE
    out (t existiert nicht)
  END IF

END PROC speicherbelegung;


(*********************** Menue 'Archiv' ***********************************)

TEXT VAR
  letzter archivname := niltext,
  zielarchiv := "ARCHIVE";

INT VAR zielstation := 0;

THESAURUS VAR archivinhalt;

BOOL VAR
  archivzugriff,
  ziel ist manager := TRUE,
  dialogue state;

LET
  p zielarchiv =  #1072#
    " Ziel: ",
  archiv heisst =  #1073#
    "Archiv heisst ",
  name des archivs =  #1074#
    "Name des Archivs:",
  name zielarchiv =  #1075#
    "Name Zielarchiv:",
  nr zielstation =  #1076#
    "Nr. der Zielstation (od. RETURN):",
  ist ziel archivmanager =  #1077#
    "Ist das Zielarchiv ein Archivmanager",
  diskette formatieren =  #1078#
    "Archivdiskette vorher formatieren",
  neuer archivname =  #1079#
    "Neuer Archivname:",
  t im system ueberschreiben =  #1080#
    " im System ueberschreiben",
  t auf archiv loeschen =  #1081#
    " auf Archiv loeschen",
  t archiv =  #1082#
    "Archiv ",
  t ueberschreiben =  #1083#
    " ueberschreiben",
  frage archiv initialisieren =  #1084#
    "Archiv initialisieren",
  t auf archiv ueberschreiben =  #1085#
    " auf Archiv ueberschreiben";

LET
  t passwort =  #1095#
    "Passwort: ",
  passwortwiederholung falsch =  #1096#
    "Passwort stimmt nicht mit der ersten Eingabe überein",
  bitte passwort wiederholen =  #1097#
    "Passwort zur Kontrolle bitte nochmal eingeben.",
  passwort loeschen =  #1098#
    "Passwort loeschen",
  falsche stationsnr =  #1099#
    "Unzlaessige Stationsnummer",
  task ist kein manager =  #1100#
    "Angegebene Task ist kein Manager";


PROC archivverwaltung (INT CONST wahl nr) :

  enable stop;
  SELECT wahl nr OF
  CASE 0 : eintritt
  CASE 1 : archivuebersicht
  CASE 2 : uebersicht drucken
  CASE 3 : datei vom archiv holen
  CASE 4 : datei auf archiv sichern
  CASE 5 : auf archiv loeschen
  CASE 6 : archiv initialisieren
  CASE 7 : zielarchiv einstellen
  CASE 8 : passwort einstellen
  CASE 9 : reservieren
  OTHERWISE verlassen
  END SELECT;
  storage kontrollieren .

eintritt :
  archivzugriff := FALSE .

datei auf archiv sichern :
  IF ziel ist manager THEN
    archivnamen holen
  END IF;
  bitte warten;
  archivinhalt := ALL eudas archiv;
  ausfuehrung (PROC (TEXT CONST) archivieren, 0) .

datei vom archiv holen :
  disable stop;
  archiv anmelden;
  bitte warten;
  archivinhalt := ALL eudas archiv;
  IF falscher name THEN archivinhalt := ALL eudas archiv END IF;
  enable stop;
  auf archiv (PROC (TEXT CONST) holen) .

auf archiv loeschen :
  IF ziel ist manager THEN
    archivnamen holen
  END IF;
  bitte warten;
  archivinhalt := ALL eudas archiv;
  auf archiv (PROC (TEXT CONST) auf archiv loeschen) .

archivuebersicht :
  archiv anmelden;
  disable stop;
  bitte warten;
  DATASPACE VAR list ds := nilspace;
  f :=sequential file (output, list ds);
  list (f, eudas archiv);
  IF falscher name THEN list (f, eudas archiv) END IF;
  IF NOT is error THEN
    modify (f); to line (f, 1);
    write record (f, headline (f));
    headline (f, niltext);
    edit (f, rechts, "SHOW/Uebersicht", FALSE)
  END IF;
  forget (list ds);
  tastenpuffer loeschen;
  enable stop .

uebersicht drucken :
  archiv anmelden;
  namen generieren;
  FILE VAR f := sequential file (output, list name);
  disable stop;
  bitte warten;
  list (f, eudas archiv);
  IF falscher name THEN list (f, eudas archiv) END IF;
  enable stop;
  modify (f);
  insert record (f);
  write record (f, headline (f));
  print (list name);
  forget (list name, quiet) .

namen generieren :
  INT VAR i := 0;
  TEXT VAR list name;
  REP
    i INCR 1;
    list name := "Archivliste " + text (i)
  UNTIL NOT exists (list name) END REP .

archiv initialisieren :
  archiv anmelden;
  IF ja (diskette formatieren, "JA/format") THEN
    archiv formatieren
  ELIF benanntes archiv THEN
    IF loeschen verneint THEN LEAVE archiv initialisieren END IF
  ELSE
    IF initialisieren verneint THEN LEAVE archiv initialisieren END IF
  END IF;
  neuen namen erfragen;
  tatsaechlich initialisieren .

archiv formatieren :
  bitte warten;
  disable stop;
  set command dialogue false;
  format (eudas archiv);
  reset command dialogue;
  enable stop .

benanntes archiv :
  reserve ("", eudas archiv);
  bitte warten;
  disable stop;
  archivinhalt := ALL eudas archiv;
  BOOL CONST ergebnis := falscher name;
  clear error;
  enable stop;
  ergebnis .

loeschen verneint :
  NOT ja (t archiv + textdarstellung (letzter archivname) + t ueberschreiben,
          "JA/archiv loeschen") .

initialisieren verneint :
  NOT ja (frage archiv initialisieren, "JA/archiv init") .

neuen namen erfragen :
  editget (neuer archivname, letzter archivname, "", "GET/Archivname");
  reserve (letzter archivname, eudas archiv) .

tatsaechlich initialisieren :
  bitte warten;
  disable stop;
  set command dialogue false;
  clear (eudas archiv);
  reset command dialogue .

zielarchiv einstellen :
  TEXT VAR zieltaskname := zielarchiv;
  IF archivzugriff THEN
    release (eudas archiv); archivzugriff := FALSE
  END IF;
  editget (name zielarchiv, zieltaskname, "", "GET/Zielarchiv");
  IF zieltaskname = niltext THEN
    LEAVE zielarchiv einstellen
  END IF;
  zielstation einlesen;
  ziel ist manager := ja (ist ziel archivmanager, "JA/Zielmanager");
  werte uebertragen;
  waehlbar (6, 6, ziel ist manager);
  waehlbar (6, 9, NOT ziel ist manager);
  bildschirm neu;
  fusszeile ausgeben (p zielarchiv, stationsnr + zielarchiv) .

zielstation einlesen :
  TEXT VAR rechner := text (station (myself));
  IF station (myself) <> 0 THEN
    editget (nr zielstation, rechner, "", "GET/Zielstation")
  END IF .

werte uebertragen :
  zielstation := int (rechner);
  IF NOT last conversion ok THEN
    errorstop (falsche stationsnr)
  END IF;
  zielarchiv := zieltaskname;
  teste auf manager (eudas archiv) .

stationsnr :
  IF zielstation = 0 THEN
    niltext
  ELSE
    text (zielstation) + "/"
  END IF .

reservieren :
  TEXT VAR parameter := niltext;
  editget (name des archivs, parameter, "", "GET/Archivname");
  reserve (parameter, eudas archiv);
  archivzugriff := TRUE .

verlassen :
  IF wahl nr = -1 THEN
    IF archivzugriff THEN
      release (eudas archiv)
    END IF;
    dialogfenster loeschen;
    fenster veraendert (fuss)
  ELIF wahl nr = -2 THEN
    fusszeile ausgeben (p zielarchiv, stationsnr + zielarchiv)
  END IF .

END PROC archivverwaltung;

TASK PROC eudas archiv :

  IF zielstation = 0 THEN
    task (zielarchiv)
  ELSE
    zielstation / zielarchiv
  END IF

END PROC eudas archiv;

PROC teste auf manager (TASK CONST t) :

  INT VAR i;
  IF station (t) = station (myself) THEN
    FOR i FROM 1 UPTO 5 REP
      IF status (t) = 2 OR status (t) = 6 THEN
        LEAVE teste auf manager
      END IF;
      pause (10)
    END REP;
    errorstop (task ist kein manager)
  END IF

END PROC teste auf manager;

PROC archivnamen holen :

  TEXT VAR neuer archivname := letzter archivname;
  editget (name des archivs, neuer archivname, "", "GET/Archivname");
  IF NOT archivzugriff OR neuer archivname <> letzter archivname THEN
    reserve (neuer archivname, eudas archiv);
    archivzugriff := TRUE
  END IF;
  letzter archivname := neuer archivname
 
END PROC archivnamen holen;

PROC archiv anmelden :

  IF NOT archivzugriff AND ziel ist manager THEN
    reserve (letzter archivname, eudas archiv);
    archivzugriff := TRUE
  END IF

END PROC archiv anmelden;

BOOL PROC falscher name :

  IF ziel ist manager AND is error THEN
    TEXT CONST meldung := errormessage;
    IF subtext (meldung, 1, 14) = archiv heisst CAND
       subtext (meldung, 16, 20) <> "?????" THEN
      clear error;
      nochmal anmelden;
      LEAVE falscher name WITH TRUE
    END IF
  END IF;
  FALSE .

nochmal anmelden :
  letzter archivname := subtext (meldung, 16, length (meldung) - 1);
  reserve (letzter archivname, eudas archiv) .

END PROC falscher name;

PROC archivieren (TEXT CONST dateiname) :

  disable stop;
  IF NOT (archivinhalt CONTAINS dateiname) COR auf archiv ueberschreiben THEN
    vorher eventuell sichern;
    bitte warten;
    set command dialogue false;
    save (dateiname, eudas archiv);
    reset command dialogue
  END IF .

auf archiv ueberschreiben :
  ja (textdarstellung (dateiname) + t auf archiv ueberschreiben, "JA/save") .

vorher eventuell sichern :
  INT CONST nr := index der arbeitskopie (dateiname);
  IF nr > 0 CAND aendern erlaubt CAND inhalt veraendert (nr) THEN
    einzelsicherung (nr)
  END IF .

END PROC archivieren;

PROC holen (TEXT CONST dateiname) :

  disable stop;
  IF NOT exists (dateiname) COR eigene datei ueberschreiben THEN
    bitte warten;
    set command dialogue false;
    fetch (dateiname, eudas archiv);
    reset command dialogue
  END IF .

eigene datei ueberschreiben :
  ja (textdarstellung (dateiname) + t im system ueberschreiben, "JA/fetch") .

END PROC holen;

PROC auf archiv loeschen (TEXT CONST dateiname) :

  disable stop;
  IF NOT (archivinhalt CONTAINS dateiname) COR auf archiv loeschen THEN
    bitte warten;
    set command dialogue false;
    erase (dateiname, eudas archiv);
    reset command dialogue
  END IF .

auf archiv loeschen :
  ja (textdarstellung (dateiname) + t auf archiv loeschen, "JA/erase") .

END PROC auf archiv loeschen;

PROC set command dialogue false :

  dialogue state := command dialogue;
  command dialogue (FALSE)

END PROC set command dialogue false;

PROC reset command dialogue :

  command dialogue (dialogue state)

END PROC reset command dialogue;

PROC auf archiv (PROC (TEXT CONST) operation) :

  TEXT VAR dateiname := niltext;
  editget (name der datei, dateiname, "z", "GET/Dateiname");
  IF dateiname = esc z THEN
    uebersicht zeigen
  ELSE
    last param (dateiname);
    operation (dateiname)
  END IF .

uebersicht zeigen :
  dateinamen sammeln (archivinhalt, 0);
  auswahl anbieten ("EUDAS-Archivauswahl", rechts, "AUSWAHL/Archiv",
                    PROC (TEXT VAR, INT CONST) als text);
  operation ausfuehren (PROC (TEXT CONST) operation) .

END PROC auf archiv;

PROC passwort einstellen :

  BOUND ROW 2 TEXT VAR pw;
  DATASPACE VAR ds := nilspace;
  pw := ds;
  disable stop;
  passwort holen (pw (1));
  IF pw (1) = niltext THEN
    fragen ob loeschen
  ELSE
    doppelt eingeben
  END IF;
  forget (ds) .

fragen ob loeschen :
  IF ja (passwort loeschen, "JA/pw loeschen") THEN
    dialog; dialog;
    enter password (niltext)
  END IF .

doppelt eingeben :
  dialog; out (bitte passwort wiederholen);
  passwort holen (pw (2));
  IF pw (1) <> pw (2) THEN
    errorstop (passwortwiederholung falsch)
  ELSE
    dialog; dialog;
    enter password (pw (1))
  END IF .

END PROC passwort einstellen;

PROC passwort holen (TEXT VAR wort) :

  enable stop;
  dialog; out (t passwort);
  get secret line (wort)

END PROC passwort holen;


(******************** Parameter-Auswahl ***********************************)

SATZ VAR sammel;

LET
  name der datei =  #1086#
    "Name der Datei:",
  name der zieldatei =  #1087#
    "Name der Zieldatei:",
  name der verarbeitungsvorschrift =  #1088#
    "Name der Verarbeitungsvorschrift:",
  name des druckmusters =  #1089#
    "Name des Druckmusters:",
  name der quelldatei =  #1090#
    "Name der Quelldatei:";

LET
  keine datei zur auswahl =  #1101#
    "Keine Datei zur Auswahl vorhanden.";

TEXT VAR
  aktueller prompt := name der datei,
  offene;


PROC dateinamen sammeln (THESAURUS CONST t, INT CONST typ) :

  uebergebene namen sammeln;
  offene dateien merken;
  zusaetzliche namen dazu;
  meldung falls keine datei .

offene dateien merken :
  offene := niltext;
  INT VAR i;
  FOR i FROM 1 UPTO anzahl dateien REP
    INT CONST t link := feldindex (sammel, eudas dateiname (i));
    IF t link > 0 THEN
      offene CAT code (t link)
    END IF
  END REP .

uebergebene namen sammeln :
  INT VAR
    stelle := 1,
    von := 0;
  satz initialisieren (sammel);
  REP
    get (t, feldpuffer, von);
    IF feldpuffer = niltext THEN
      LEAVE uebergebene namen sammeln
    ELIF typ = 0 COR type (old (feldpuffer)) = typ THEN
      feld aendern (sammel, stelle, feldpuffer);
      stelle INCR 1
    END IF
  END REP .

zusaetzliche namen dazu :
  von := 0;
  REP
    get (zusaetzliche namen, feldpuffer, von);
    IF feldpuffer = niltext THEN
      LEAVE zusaetzliche namen dazu
    ELIF NOT (t CONTAINS feldpuffer) THEN
      feld aendern (sammel, stelle, feldpuffer);
      stelle INCR 1
    END IF
  END REP .

meldung falls keine datei :
  IF stelle = 1 THEN
    dialog; out (keine datei zur auswahl);
    errorstop (niltext)
  END IF .

END PROC dateinamen sammeln;

PROC als text (TEXT VAR inhalt, INT CONST stelle) :

  IF stelle < 256 THEN
    feld lesen (sammel, stelle, inhalt);
    IF pos (offene, code (stelle)) > 0 THEN
      inhalt := "<!> " + textdarstellung (inhalt)
    ELIF inhalt <> niltext THEN
      inhalt := textdarstellung (inhalt)
    END IF
  ELSE
    inhalt := niltext
  END IF

END PROC als text;

PROC operation ausfuehren (PROC (TEXT CONST) operation) :

  INT VAR
    stelle := 1;
  REP
    IF wahl (stelle) = 0 THEN
      LEAVE operation ausfuehren
    ELSE
      feld lesen (sammel, wahl (stelle), feldpuffer);
      dialog; out (text (stelle, 3)); out (". ");
      out (textdarstellung (feldpuffer));
      last param (feldpuffer);
      operation (feldpuffer)
    END IF;
    stelle INCR 1
  END REP

END PROC operation ausfuehren;

PROC ausfuehrung (PROC (TEXT CONST) operation, INT CONST typ) :

  enable stop;
  TEXT VAR dateiname;
  dateinamen anfordern (dateiname, typ);
  IF dateiname = esc z THEN
    operation ausfuehren (PROC (TEXT CONST) operation)
  ELSE
    last param (dateiname);
    operation (dateiname)
  END IF

END PROC ausfuehrung;

PROC einzelausfuehrung (PROC (TEXT CONST) operation, INT CONST typ) :

  enable stop;
  TEXT VAR dateiname;
  dateinamen anfordern (dateiname, typ);
  IF dateiname = esc z THEN
    IF wahl (1) = 0 THEN
      errorstop (niltext)
    ELSE
      feld lesen (sammel, wahl (1), dateiname)
    END IF
  END IF;
  last param (dateiname);
  operation (dateiname)

END PROC einzelausfuehrung;

PROC dateinamen anfordern (TEXT CONST prompt) :

  aktueller prompt := prompt

END PROC dateinamen anfordern;

PROC dateinamen anfordern (TEXT VAR dateiname, INT CONST typ) :

  IF exists (std) AND (typ = 0 COR type (old (std)) = typ) THEN
    dateiname := std
  ELSE
    dateiname := niltext
  END IF;
  disable stop;
  editget (aktueller prompt, dateiname, "z", "GET/Dateiname");
  aktueller prompt := name der datei;
  enable stop;
  IF dateiname = niltext THEN
    errorstop (niltext)
  ELIF dateiname = esc z THEN
    dateinamen sammeln (all, typ);
    auswahl anbieten ("EUDAS-Dateiauswahl", rechts, "AUSWAHL/Datei",
                      PROC (TEXT VAR, INT CONST) als text);
    bitte warten
  END IF

END PROC dateinamen anfordern;

PROC aus sammel (TEXT VAR inhalt, INT CONST stelle) :

  IF stelle <= 256 THEN
    feld lesen (sammel, stelle, inhalt)
  ELSE
    inhalt := niltext
  END IF

END PROC aus sammel;

PROC frage ob einrichten (TEXT CONST dateiname) :

  IF NOT ja (textdarstellung (dateiname) + t neu einrichten, 
             "JA/einrichten") THEN
    errorstop (niltext)
  END IF

END PROC frage ob einrichten;


(************************** Editor ****************************************)

LET
  edit status =  #1091#
"EDITIEREN:   Abbruch: ESC h   Verlassen: ESC q   Hilfe: ESC ?",
  show status =  #1092#
"ZEIGEN:   Blättern: HOP OBEN, HOP UNTEN   Ende: ESC q   Hilfe: ESC ?";

INT VAR return code;

BOOL VAR
  zeige edit status,
  feldanzeige erlaubt;


PROC edit (FILE VAR f, FENSTER CONST fenster, TEXT CONST hilfe,
           BOOL CONST aendern) :

  INT VAR x, y, x l, y l;
  fenstergroesse (fenster, x, y, x l, y l);
  fenster veraendert (fenster);
  enable stop;
  feldanzeige erlauben;
  zeige edit status := aendern;
  REP
    edit status anzeigen;
    open editor (groesster editor + 1, f, aendern, x, y, x l, y l);
    edit (groesster editor, "eqvw19dpgn"9"?hF", PROC (TEXT CONST) kdo);
    return code behandeln
  END REP .

feldanzeige erlauben :
  IF aendern AND y < 3 AND y l > 22 AND x < 14 AND x l > 75 THEN
    feldanzeige erlaubt := TRUE
  ELSE
    feldanzeige erlaubt := FALSE
  END IF .

return code behandeln :
  SELECT return code OF
  CASE 0 : LEAVE edit
  CASE 1 : hilfe anbieten (hilfe, fenster)
  CASE 2 : errorstop (niltext)
  END SELECT .

END PROC edit;

PROC edit status anzeigen :

  IF zeige edit status THEN
    status anzeigen (edit status)
  ELSE
    status anzeigen (show status)
  END IF

END PROC edit status anzeigen;

PROC kdo (TEXT CONST zeichen) :

  return code := pos ("q?h", zeichen);
  IF return code > 0 THEN
    return code DECR 1;
    quit
  ELIF feldanzeige erlaubt CAND zeichen = "F" THEN
    feldnamen anzeigen;
    edit status anzeigen
  ELSE
    std kommando interpreter (zeichen);
    edit status anzeigen;
    bildschirm neu
  END IF

END PROC kdo;

PROC feldnamen anzeigen :

  IF anzahl felder > 0 THEN
    feldnamen sammeln;
    sammlung zur auswahl anbieten;
    ergebnis in editor uebernehmen
  END IF .

feldnamen sammeln :
  INT VAR feldnr;
  satz initialisieren (sammel, anzahl felder);
  FOR feldnr FROM 1 UPTO anzahl felder REP
    feldnamen lesen (feldnr, feldpuffer);
    feld aendern (sammel, feldnr, feldpuffer)
  END REP .

sammlung zur auswahl anbieten :
  auswahl anbieten ("EUDAS-Editfelder", rechts, "AUSWAHL/Feldnamen",
                    PROC (TEXT VAR, INT CONST) aus sammel) .

ergebnis in editor uebernehmen :
  INT VAR stelle := 1;
  WHILE wahl (stelle) > 0 REP
    IF stelle > 1 THEN push (blank) END IF;
    feldnamen lesen (wahl (stelle), feldpuffer);
    push (""""); push (feldpuffer); push ("""");
    stelle INCR 1
  END REP .

END PROC feldnamen anzeigen;

END PACKET eudas steuerung;