From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <lars@6xq.net>
Date: Mon, 4 Feb 2019 13:09:03 +0100
Subject: Initial import

---
 app/eudas/5.3/src/eudas.steuerung.14 | 2535 ++++++++++++++++++++++++++++++++++
 1 file changed, 2535 insertions(+)
 create mode 100644 app/eudas/5.3/src/eudas.steuerung.14

(limited to 'app/eudas/5.3/src/eudas.steuerung.14')

diff --git a/app/eudas/5.3/src/eudas.steuerung.14 b/app/eudas/5.3/src/eudas.steuerung.14
new file mode 100644
index 0000000..f96047b
--- /dev/null
+++ b/app/eudas/5.3/src/eudas.steuerung.14
@@ -0,0 +1,2535 @@
+PACKET eudas steuerung
+
+(*************************************************************************)
+(*                                                                       *)
+(*     Menuesteuerung von EUDAS                                          *)
+(*                                                                       *)
+(*     Version 14                                                        *)
+(*                                                                       *)
+(*     Autor: Thomas Berlage                                             *)
+(*     Stand: 06.02.89                                                   *)
+(*                                                                       *)
+(*************************************************************************)
+
+  DEFINES
+
+  eudas,
+
+  einzelsicherung,
+  suchen,
+  aendern,
+  einfuegen,
+  prueffehler editieren,
+  feldstruktur,
+  feldnamen anzeigen,
+  formatieren automatisch,
+
+  arbeitsbereich bestimmen,
+  dateiverwaltung,
+  archivverwaltung :
+
+
+
+(**************************** Variablen ***********************************)
+
+INT VAR
+  file typ := 1003,
+  eudas typ := 3243;
+
+IF l3 THEN file typ := 1004 END IF .
+
+l3 : maxint DIV 2 > 17000 .
+;
+
+LET
+  niltext = "",
+  blank = " ",
+  cleop = ""4"",
+  cleol = ""5"";
+
+FILE VAR test file;
+
+DATASPACE VAR test ds;
+
+INT VAR
+  belegter heap,
+  test version := dateiversion - 1;
+
+TEXT VAR
+  feldpuffer;
+
+
+(*************************** EUDAS ***************************************)
+
+BOOL VAR
+  eudas schon aktiv := FALSE;
+
+LET
+  menue 1 =  #1101#
+    "EUDAS.Öffnen",
+  menue 2 =  #1102#
+    "EUDAS.Einzelsatz",
+  menue 3 =  #1103#
+    "EUDAS.Gesamtdatei",
+  menue 4 =  #1104#
+    "EUDAS.Drucken",
+  menue 5 =  #1105#
+    "EUDAS.Dateien",
+  menue 6 =  #1106#
+    "EUDAS.Archiv";
+
+LET
+  kein rekursiver aufruf =  #1107#
+    "EUDAS kann nicht unter EUDAS aufgerufen werden",
+  suchmuster eingeben =  #1108#
+    "Suchbedingung einstellen",
+  alle saetze drucken =  #1109#
+    "Alle Sätze drucken",
+  alle markierten saetze drucken =  #1110#
+    "Alle markierten Sätze drucken",
+  einzelsatz drucken =  #1111#
+    "Aktuellen Satz drucken",
+  uebersicht wiederholen =  #1112#
+    "Mit neuer Auswahl noch einmal",
+  akt datei =  #1113#
+    ""15"Akt.Datei "14"",
+  datum doppelpunkt =  #1114#
+    ""15"Datum "14"";
+
+
+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 :
+  fenstergroessen bestimmen;
+  page; bildschirm neu;
+  belegter heap := heap size;
+  disable stop;
+  eudas schon aktiv := TRUE;
+  menue anbieten (ROW 6 TEXT : (menue 1, menue 2, menue 3,
+                                menue 4, menue 5, menue 6),
+                  fenster 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 := niltext;
+  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
+    einzelausfuehrung (name des druckmusters, file typ,
+                       PROC (TEXT CONST) drucke uebersicht)
+  ELIF markierte saetze > 0 CAND alle markierten drucken THEN
+    einzelausfuehrung (name des druckmusters, file typ,
+                       PROC (TEXT CONST) drucke uebersicht);
+    markierungen loeschen
+  ELIF einzelsatz THEN
+    markierungen loeschen; markierung aendern;
+    einzelausfuehrung (name des druckmusters, file typ,
+                       PROC (TEXT CONST) drucke uebersicht);
+    markierungen loeschen
+  END IF .
+
+alle drucken :
+  ja (alle saetze drucken, "JA/alle Saetze", FALSE) .
+
+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", FALSE) .
+
+END PROC eudas kurzabfrage;
+
+PROC bild frei :
+
+  bildschirm neu;
+  cursor (1, 1);
+  out (cleop)
+
+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 (menuenr, 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;
+  fusszeile ("", "", 35, datum doppelpunkt, 64);
+  fussteil (3, date) .
+
+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 12 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 8 UPTO 11 REP
+    waehlbar (2, i, wie)
+  END REP;
+  waehlbar (3, 2, wie);
+  waehlbar (3, 3, wie)
+
+END PROC aendern sperre;
+
+
+(**************************** Menue 'Oeffnen' *****************************)
+
+LET
+  p manager =  #1115#
+    ""15"Manager "14"",
+  t manager ausschalten =  #1116#
+    "Manager ausschalten",
+  keine sicherung noetig =  #1117#
+    "Keine Sicherung nötig.",
+  arbeitskopien loeschen =  #1118#
+    "Interne Arbeitskopien löschen",
+  t arbeitskopie =  #1119#
+    "Arbeitskopie ",
+  t unveraendert =  #1120#
+    " unverändert.",
+  t veraendert =  #1121#
+    " verändert! Optionen zum Sichern:",
+(*t alte ersetzen =  #1122#
+    "Statt alter Version",
+  t sichern neuer name =  #1123#
+    "Unter neuem Namen",
+  t vergessen =  #1124#
+    "Ignorieren",*)
+  unter dem namen =  #1125#
+    "Sichern unter dem neuen Namen:",
+  ueberschreiben =  #1126#
+    " überschreiben",
+  sortierung wiederherstellen =  #1127#
+    "Datei wieder sortieren",
+  t notizen ansehen =  #1128#
+    "Notizen",
+  name task =  #1129#
+    "Name Managertask:",
+  task existiert nicht =  #1130#
+    "Task existiert nicht !",
+  wollen sie etwas veraendern =  #1131#
+    "Wollen Sie etwas verändern (eine Arbeitskopie anlegen)",
+  markierungen geloescht =  #1132#
+    "Alle Markierungen gelöscht.",
+  t pruefbedingungen =  #1133#
+    "Prüfbedingungen",
+  t feldnamen aendern =  #1134#
+    "Feldnamen ändern",
+  t feldtypen aendern =  #1135#
+    "Feldtypen ändern",
+  t feldnamen anfuegen =  #1136#
+    "Feldnamen anfügen",
+  neuer feldname =  #1137#
+    "Neuer Feldname:",
+  t feldtypen =  #1138#
+    "Typwahl für Feld ",
+  neue feldnamen eingeben =  #1139#
+    "Neue Feldnamen",
+  id text =  #1140#
+    "TEXT ",
+  id din =  #1141#
+    " DIN ",
+  id zahl =  #1142#
+    "ZAHL ",
+  id datum =  #1143#
+    "DATUM",
+  alte feldreihenfolge aendern =  #1144#
+    "Alte Feldreihenfolge ändern",
+  speicherengpass =  #1145#
+    ""7"ACHTUNG: System voll, Dateien löschen!";
+
+BOOL VAR
+  nach aendern fragen,
+  multi user manager eingestellt := FALSE;
+
+TASK VAR multi user manager := niltask;
+
+TEXT VAR
+  manager taskname := niltext;
+
+SATZ VAR feldersatz;
+
+ROW 6 TEXT VAR typen auswahl;
+    typen auswahl (1) := id text;
+    typen auswahl (2) := id din;
+    typen auswahl (3) := id zahl;
+    typen auswahl (4) := id datum;
+    typen auswahl (5) := niltext;
+    typen auswahl (6) := niltext;
+
+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;
+  storage kontrollieren;
+  heap kontrollieren .
+
+auf geschlossene datei pruefen :
+  IF anzahl dateien = 0 THEN
+    eudas interpreter (0, 0)
+  END IF;
+  akt dateiname in fuss;
+  fussteil (2, p manager, manager taskname) .
+
+neue datei oeffnen :
+  auf sicherung ueberpruefen;
+  oeffnen im menue (TRUE);
+  IF anzahl dateien > 0 THEN push ("2") END IF .
+
+datei ketten :
+  oeffnen op (PROC (TEXT CONST) ketten) .
+
+datei koppeln :
+  oeffnen op (PROC (TEXT CONST) koppeln) .
+
+aktuelle datei sichern :
+  IF aendern erlaubt THEN
+    einzeldateien abfragen
+  ELSE
+    dateien loeschen (FALSE);
+    dialog (keine sicherung noetig)
+  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;
+  akt dateiname in fuss .
+
+notizen editieren :
+  notizen ansehen;
+  dialogfenster loeschen .
+
+feldstruktur aendern :
+  zugriff (PROC (EUDAT VAR) feldstruktur) .
+
+pruefbedingungen aendern :
+  pruefbedingungen;
+  dialogfenster loeschen .
+
+multi user manager einstellen :
+  TEXT VAR edit manager name := "";
+  editget (name task, edit manager name, "", "GET/multi task");
+  IF edit manager name = niltext THEN
+    IF manager ausschalten THEN set manager (niltext, FALSE) END IF
+  ELIF exists task (edit manager name) THEN
+    teste auf manager (task (edit manager name));
+    set manager (edit manager name, TRUE)
+  ELSE
+    errorstop (task existiert nicht)
+  END IF .
+
+manager ausschalten :
+  ja (t manager ausschalten, "JA/manager aus") .
+
+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;
+    LEAVE oeffnen interpreter
+  END IF .
+
+END PROC oeffnen interpreter;
+
+PROC oeffnen op (PROC (TEXT CONST) operation) :
+
+  ausfuehrung (name der datei, TRUE, eudas typ, multi user manager,
+               PROC (TEXT CONST) operation);
+  ketten koppeln sperre;
+  akt dateiname in fuss
+
+END PROC oeffnen op;
+
+PROC akt dateiname in fuss :
+
+  TEXT VAR f text := niltext;
+  IF anzahl dateien > 0 THEN
+    f text CAT """";
+    f text CAT eudas dateiname (1);
+    f text CAT """"
+  END IF;
+  IF anzahl dateien > 1 THEN
+    f text CAT " .."
+  END IF;
+  fussteil (1, akt datei, f text)
+
+END PROC akt dateiname in fuss;
+
+PROC set manager (TEXT CONST m name, BOOL CONST an) :
+
+  IF an THEN
+    multi user manager := task (m name)
+  ELSE
+    multi user manager := niltask
+  END IF;
+  multi user manager eingestellt := an;
+  manager taskname := m name;
+  fussteil (2, manager taskname)
+
+END PROC set manager;
+
+PROC auf sicherung ueberpruefen :
+
+  BOOL VAR notwendig := FALSE;
+  IF aendern erlaubt THEN
+    wirklich pruefen
+  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
+    sicherung durchfuehren
+  ELSE
+    dialog (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 :
+  INT VAR ergebnis := 1;
+  auswahl anbieten ("WAHL.Sichern", frage, "WAHL/sichere", ergebnis);
+  ergebnis auswerten .
+
+ergebnis auswerten :
+  TEXT VAR name := eudas dateiname (datei nr);
+  SELECT ergebnis OF
+  CASE 1 : alte version ueberschreiben
+  CASE 3 : unter neuem namen sichern
+  END SELECT;
+  IF ergebnis <> 2 THEN
+    unter namen sichern
+  END IF .
+
+alte version ueberschreiben :
+  forget (name, quiet) .
+
+unter neuem namen sichern :
+  edit get (unter dem namen, name, "", "GET/Sicherungsname");
+  IF exists (name) OR im manager vorhanden THEN
+    eventuell ueberschreiben
+  END IF .
+
+im manager vorhanden :
+  manager herkunft (dateinr) CAND exists (name, herkunft (datei nr)) .
+
+eventuell ueberschreiben :
+  IF ja (textdarstellung (name) + ueberschreiben, "JA/ueber", FALSE) THEN
+    forget (name, quiet)
+  ELSE
+    einzelsicherung (datei nr);
+    LEAVE einzelsicherung
+  END IF .
+
+unter namen sichern :
+  sichere (datei nr, name);
+  eventuell sortierung wiederherstellen;
+  ggf in manager sichern .
+
+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") .
+
+ggf in manager sichern :
+  IF manager herkunft (datei nr) THEN
+    disable stop;
+    set command dialogue false;
+    save (name, herkunft (datei nr));
+    reset command dialogue;
+    enable stop;
+    forget (name, quiet)
+  END IF .
+
+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;
+  nach aendern fragen := aendern fragen;
+  oeffnen op (PROC (TEXT CONST) oeffnen);
+  enable stop;
+  IF anzahl dateien > 0 THEN
+    oeffnen sperre (TRUE);
+    aendern sperre (aendern erlaubt)
+  END IF
+
+END PROC oeffnen im menue;
+
+PROC dateien aus manager zuruecksichern :
+
+  INT VAR datei nr;
+  FOR datei nr FROM 1 UPTO anzahl dateien REP
+    IF manager herkunft (datei nr) THEN
+      free an manager
+    END IF
+  END REP .
+
+free an manager :
+  free (eudas dateiname (datei nr), herkunft (datei nr)) .
+
+END PROC dateien aus manager zuruecksichern;
+
+PROC oeffnen (TEXT CONST dateiname) :
+
+  BOOL VAR auch aendern;
+  TASK VAR ursprung;
+  eventuell neu einrichten;
+  oeffne (dateiname, auch aendern, ursprung) .
+
+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;
+    ursprung := niltask
+  ELSE
+    auch aendern := nach aendern fragen CAND
+          ja (wollen sie etwas veraendern, "JA/oeffne", FALSE);
+    aus manager besorgen (dateiname, auch aendern, ursprung)
+  END IF .
+
+datei existiert nicht :
+  NOT exists (dateiname) AND auch nicht im manager .
+
+auch nicht im manager :
+  NOT multi user manager eingestellt COR
+    NOT exists (dateiname, multi user manager) .
+
+END PROC oeffnen;
+
+PROC ketten (TEXT CONST dateiname) :
+
+  TASK VAR ursprung;
+  aus manager besorgen (dateiname, aendern erlaubt, ursprung);
+  kette (dateiname, ursprung)
+
+END PROC ketten;
+
+PROC koppeln (TEXT CONST dateiname) :
+
+  TASK VAR ursprung;
+  aus manager besorgen (dateiname, aendern erlaubt, ursprung);
+  kopple (dateiname, ursprung)
+
+END PROC koppeln;
+
+PROC aus manager besorgen (TEXT CONST dateiname, BOOL CONST mit lock,
+                           TASK VAR ursprung) :
+
+  ursprung := niltask;
+  IF multi user manager eingestellt THEN
+    manager abfragen
+  END IF .
+
+manager abfragen :
+  IF NOT exists (dateiname) CAND exists (dateiname, multi user manager) THEN
+    IF mit lock THEN
+      lock (dateiname, multi user manager)
+    END IF;
+    forget (dateiname, quiet);
+    fetch (dateiname, multi user manager);
+    ursprung := multi user manager
+  END IF .
+
+END PROC aus manager besorgen;
+
+BOOL PROC manager herkunft (INT CONST dateinr) :
+
+  NOT is niltask (herkunft (dateinr))
+
+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, fenster 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) :
+
+  INT VAR feldnr;
+  feldnamen lesen (eudat, feldersatz);
+  IF feldnamen auch aendern THEN
+    feldnamen anbieten und aendern
+  END IF;
+  IF feldnamen anfuegen THEN
+    feldnamen editieren
+  END IF;
+  IF ja (t feldtypen aendern, "JA/Feldtypen aendern", FALSE) THEN
+    feldtypen anbieten und aendern
+  END IF;
+  feldnamen aendern (eudat, feldersatz) .
+
+feldnamen auch aendern :
+  felderzahl (feldersatz) > 0 CAND
+    ja (t feldnamen aendern, "JA/Feldnamen aendern", FALSE) .
+
+feldnamen anfuegen :
+  felderzahl (feldersatz) = 0 COR
+    ja (t feldnamen anfuegen, "JA/feldnamen", FALSE) .
+
+feldnamen anbieten und aendern :
+  felder anbieten (eudat);
+  feldnr := 1;
+  WHILE wahl (feldnr) > 0 REP
+    einen feldnamen aendern;
+    feldnr INCR 1
+  END REP .
+
+einen feldnamen aendern :
+  TEXT VAR feldname;
+  feld lesen (feldersatz, wahl (feldnr), feldname);
+  editget (neuer feldname, feldname, "", "GET/feldname");
+  feld aendern (feldersatz, wahl (feldnr), feldname) .
+
+feldnamen editieren :
+  DATASPACE VAR ds := nilspace;
+  FILE VAR f := sequential file (output, ds);
+  disable stop;
+  feldnamen anbieten (f, feldersatz);
+  forget (ds);
+  enable stop;
+  feldnamen aendern (eudat, feldersatz) .
+
+feldtypen anbieten und aendern :
+  felder anbieten (eudat);
+  feldnr := 1;
+  WHILE wahl (feldnr) > 0 REP
+    einen feldtyp aendern;
+    feldnr INCR 1
+  END REP .
+
+einen feldtyp aendern :
+  INT VAR ergebnis := feldinfo (eudat, wahl (feldnr)) + 2;
+  feld lesen (feldersatz, wahl (feldnr), feldname);
+  auswahl anbieten ("WAHL.Typen",
+                    t feldtypen + textdarstellung (feldname),
+                    "WAHL/Feldtypen", ergebnis);
+  feldinfo (eudat, wahl (feldnr), ergebnis - 2) .
+
+END PROC feldstruktur;
+
+PROC felder anbieten (EUDAT CONST eudat) :
+
+  feldtypen dazuschreiben;
+  auswahl anbieten ("EUDAS-Felder", fenster rechts, "AUSWAHL/Felder",
+                     PROC (TEXT VAR, INT CONST) aus sammel) .
+
+feldtypen dazuschreiben :
+  INT VAR feldnr;
+  satz initialisieren (sammel);
+  FOR feldnr FROM 1 UPTO felderzahl (feldersatz) REP
+    feld lesen (feldersatz, feldnr, feldpuffer);
+    feld aendern (sammel, feldnr, info + feldpuffer)
+  END REP .
+
+info :
+  "<" + typen auswahl (feldinfo (eudat, feldnr) + 2) + "> " .
+
+END PROC felder anbieten;
+
+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, fenster 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, fenster 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;
+
+PROC storage kontrollieren :
+
+  INT VAR size, used;
+  storage (size, used);
+  IF used > size THEN
+    neuer dialog;
+    dialog (speicherengpass)
+  END IF
+
+END PROC storage kontrollieren;
+
+
+(************************* Menue 'Einzelsatz' *****************************)
+
+BOOL VAR
+  satz leer,
+  umgeschaltet aus einfuegen := FALSE,
+  umgeschaltet aus aendern := FALSE;
+
+LET
+  aendern status =  #1146#
+"SATZ ÄNDERN:    Abbruch: ESC h    Beenden: ESC q    Hilfe: ESC ?",
+  einfuegen status =  #1147#
+"SATZ EINFÜGEN:    Abbruch: ESC h    Beenden: ESC q    Hilfe: ESC ?",
+  suchen status =  #1148#
+"SUCHMUSTER EINGEBEN:    Abbruch: ESC h    Beenden: ESC q    Hilfe: ESC ?",
+  umschalten auf =  #1149#
+    "Umschalten auf Koppeldatei ",
+  koppelfelder uebernehmen =  #1150#
+    "Koppelfelder übernehmen",
+  ungueltige satznummer =  #1151#
+    "Ungültige Satznummer",
+  neue satznummer =  #1152#
+    "Neue Satznummer:",
+  wzk =  #1153#
+    "wzK",
+  wz =  #1154#
+    "wz";
+
+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 : auf satz nach schluessel
+  CASE 5 : saetze auswaehlen
+  CASE 6 : auswahlbedingung loeschen
+  CASE 7 : aktuelle markierung aendern
+  CASE 8 : neuen satz einfuegen
+  CASE 9 : aktuellen satz aendern
+  CASE 10: einzelsatz tragen
+  CASE 11: einzelsatz holen
+  CASE 12: felder auswaehlen
+  CASE 13: esc oben
+  CASE 14: esc unten
+  CASE 15: esc 1
+  CASE 16: esc 9
+  CASE 17: esc k
+  OTHERWISE anzeige update
+  END SELECT;
+  storage kontrollieren .
+
+anzeige einschalten :
+  akt dateiname in fuss;
+  fussteil (2, "", "");
+  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;
+  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 .
+
+auf satz nach schluessel :
+  TEXT VAR name schluesselfeld;
+  feldnamen lesen (1, name schluesselfeld);
+  nr := niltext;
+  editget (name schluesselfeld + ":", nr, "", "GET/auf Schluessel");
+  auf satz (nr);
+  bild ausgeben (FALSE) .
+
+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;
+  einzelausfuehrung (name der zieldatei, eudas typ,
+                     PROC (TEXT CONST) trage satz und frage);
+  bild ausgeben (TRUE) .
+
+einzelsatz holen :
+  last param darf nicht geoeffnet sein;
+  einzelausfuehrung (name der quelldatei, eudas typ,
+                     PROC (TEXT CONST) hole satz);
+  bild ausgeben (TRUE) .
+
+felder auswaehlen :
+  TEXT VAR wahlvektor := niltext;
+  felder waehlen lassen (wahlvektor,
+                        "EUDAS-Anzeigefelder", "AUSWAHL/Anzeigefelder");
+  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 :
+  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
+      bild ausgeben (FALSE)
+    END IF
+  ELSE
+    dialogfenster loeschen
+  END IF .
+
+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", fenster rechts)
+
+END PROC suchen hilfe;
+
+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", fenster 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
+           END IF;
+           bitte warten; zurueck (2)
+  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", fenster 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
+    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,
+                            TEXT CONST name auswahl, name hilfe) :
+
+  auswahl anbieten (name auswahl, fenster rechts, 256, name hilfe,
+                    wahlvektor,
+                    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
+  name der datei =  #1155#
+    "Name der Datei:",
+  name der zieldatei =  #1156#
+    "Name der Zieldatei:",
+  name der verarbeitungsvorschrift =  #1157#
+    "Name der Verarbeitungsvorschrift:",
+  name des druckmusters =  #1158#
+    "Name des Druckmusters:",
+  name der quelldatei =  #1159#
+    "Name der Quelldatei:";
+
+LET
+  felder auswaehlen =  #1160#
+    "Angezeigte Felder auswählen",
+  aufsteigend sortieren =  #1161#
+    " aufsteigend sortieren";
+
+TEXT VAR
+  uebersichtsauswahl := niltext;
+
+INT VAR
+  version uebersicht := 0;
+
+DATASPACE VAR
+  kopier ds;
+
+
+PROC bearbeiten interpreter (INT CONST wahl nr) :
+
+  SELECT wahl nr OF
+  CASE 0 : fusszeile aktualisieren
+  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 .
+
+fusszeile aktualisieren :
+  akt dateiname in fuss;
+  fussteil (2, "", "") .
+
+saetze tragen :
+  last param darf nicht geoeffnet sein;
+  einzelausfuehrung (name der zieldatei, eudas typ,
+                     PROC (TEXT CONST) trage saetze) .
+
+saetze kopieren :
+  last param darf nicht geoeffnet sein;
+  einzelausfuehrung (name der zieldatei, eudas typ,
+                     PROC (TEXT CONST) kopiere saetze);
+  dialogfenster loeschen .
+
+nach vorschrift aendern :
+  ausfuehrung (name der verarbeitungsvorschrift, file typ,
+               PROC (TEXT CONST) verarbeite mit edit);
+  dialogfenster loeschen .
+
+uebersicht ausgeben :
+  IF dateiversion <> version uebersicht THEN
+    uebersichtsauswahl := niltext;
+    version uebersicht := dateiversion
+  END IF;
+  feldauswahl fuer uebersicht (uebersichtsauswahl);
+  uebersicht (uebersichtsauswahl, PROC uebersicht hilfe);
+  dialogfenster loeschen .
+
+datei sortieren :
+  zugriff (PROC (EUDAT VAR) einzelsortiere) .
+
+alle markierungen loeschen :
+  markierungen loeschen;
+  dialog (markierungen geloescht) .
+
+ggf dialogfenster loeschen :
+  IF wahl nr = -1 THEN
+    dialogfenster loeschen
+  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 (text (lines (test file)) + 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) :
+
+  IF ja (felder auswaehlen, "JA/Ub.Felder") THEN
+    felder waehlen lassen (uebersichtsauswahl,
+                          "EUDAS-Anzeigefelder", "AUSWAHL/Anzeigefelder")
+  END IF
+
+END PROC feldauswahl fuer uebersicht;
+
+PROC uebersicht hilfe :
+
+  hilfe anbieten ("UEBERSICHT", fenster 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, fenster 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, fenster 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", FALSE) .
+
+sortierreihenfolge aendern :
+  feldnamen lesen (eudat, sammel);
+  auswahl anbieten ("EUDAS-Sortierfelder", fenster rechts, 1024,
+                    "AUSWAHL/Sortierfelder", reihenfolge,
+                    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 =  #1162#
+    "Ausgabe automatisch zum Drucker",*)
+  name druckzieldatei =  #1163#
+    "Name Ausgabedatei:",
+  zwischendatei drucken =  #1210#
+    "Erzeugte Ausgabe ausdrucken",
+  zwischendatei loeschen =  #1211#
+    "Erzeugte Ausgabe löschen",
+  welche richtung =  #1212#
+    "Richtung der Druckausgabe:",
+  welche listenform =  #1213#
+    "Form der Liste:",
+  t max listenbreite =  #1214#
+    "Anzahl Zeichen pro Zeile:",
+  keine zahl angegeben =  #1215#
+    "Eingabe ist keine gültige Zahl",
+  sortierfrage =  #1164#
+    "Zieldatei anschließend sortieren",
+  pruefbedingungen testen =  #1165#
+    "Prüfbedingungen testen",
+  prueffehler festgestellt =  #1166#
+    "Prüffehler festgestellt",
+  nicht in offene datei =  #1167#
+    "Zieldatei darf nicht geöffnet sein",
+  name kopiermuster =  #1168#
+    "Name Kopiermuster (RET=Std):";
+
+LET
+  z form =  #1169#
+    " zeilenweise formatieren",
+  s form =  #1170#
+    " seitenweise formatieren";
+
+LET
+  m drucke direkt     = 0,
+  m drucke auf schirm = 1,
+  m drucke in datei   = 2;
+
+BOOL VAR
+  zeilen automatisch := FALSE,
+  seiten automatisch := FALSE;
+
+
+PROC drucken interpreter (INT CONST wahl nr) :
+
+  SELECT wahl nr OF
+  CASE 0 : fusszeile aktualisieren
+  CASE 1 : nach muster drucken
+  CASE 2 : standardlisten
+  CASE 3 : ausgaberichtung umschalten
+  CASE 4 : musterdatei aendern
+  CASE 5 : textdatei drucken
+  CASE 6 : nachbearbeiten
+  OTHERWISE ggf dialogfenster loeschen
+  END SELECT;
+  storage kontrollieren .
+
+fusszeile aktualisieren :
+  akt dateiname in fuss;
+  fussteil (2, "", "") .
+
+nach muster drucken :
+  ausfuehrung (name des druckmusters, file typ,
+               PROC (TEXT CONST) drucke mit edit);
+  dialogfenster loeschen .
+
+standardlisten :
+  INT VAR listenform := 1;
+  auswahl anbieten ("WAHL.Std-Listen", welche listenform, "WAHL/Std-Listen",
+                    listenform);
+  feldliste erfragen;
+  listenfont erfragen;
+  listenbreite erfragen;
+  ausgabedatei erfragen;
+  bild frei fuer uebersetzung;
+  drucke standardlisten (listenform, feldliste);
+  ergebnis anbieten .
+
+feldliste erfragen :
+  TEXT VAR feldliste := niltext;
+  felder waehlen lassen (feldliste,
+                        "EUDAS-Druckfelder", "AUSWAHL/Druckfelder") .
+
+listenfont erfragen :
+  .
+
+listenbreite erfragen :
+  TEXT VAR edit zahl := text (std listenbreite);
+  editget (t max listenbreite, edit zahl, "", "GET/listenbreite");
+  INT CONST neue breite := int (edit zahl);
+  IF NOT last conversion ok THEN
+    errorstop (keine zahl angegeben)
+  ELSE
+    std listenbreite (neue breite)
+  END IF .
+
+ausgaberichtung umschalten :
+  INT VAR ergebnis := druckrichtung + 1;
+  auswahl anbieten ("WAHL.Richtung", welche richtung, "WAHL/Richtung",
+                    ergebnis);
+  druckrichtung (ergebnis - 1) .
+
+musterdatei aendern :
+  ausfuehrung (name der datei, file typ,
+               PROC (TEXT CONST) muster edit);
+  dialogfenster loeschen .
+
+textdatei drucken :
+  ausfuehrung (name der datei, file typ,
+               PROC (TEXT CONST) print) .
+
+nachbearbeiten :
+  ausfuehrung (name der datei, file typ,
+               PROC (TEXT CONST) nachbearbeitung);
+  dialogfenster loeschen .
+
+ggf dialogfenster loeschen :
+  IF wahl nr = -1 THEN
+    dialogfenster loeschen
+  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;
+  ausgabedatei erfragen;
+  bild frei fuer uebersetzung;
+  disable stop;
+  drucke (dateiname);
+  ergebnis anbieten;
+  uebersetzungsfehler behandeln .
+
+END PROC drucke mit edit;
+
+PROC ausgabedatei erfragen :
+
+  IF druckrichtung = m drucke in datei THEN
+    TEXT VAR dateiname := druckdatei;
+    IF pos (dateiname, "$") > 0 THEN dateiname := niltext END IF;
+    editget (name druckzieldatei, dateiname, "", "GET/Druckdatei");
+    IF dateiname <> niltext THEN
+      druckdatei (dateiname)
+    END IF
+  END IF
+
+END PROC ausgabedatei erfragen;
+
+PROC ergebnis anbieten :
+
+  IF NOT is error CAND druckrichtung = m drucke auf schirm CAND
+       exists (druckdatei) THEN
+    enable stop;
+    zwischendatei zeigen
+  END IF .
+
+zwischendatei zeigen :
+  FILE VAR ausgabefile := sequential file (input, druckdatei);
+  edit (ausgabefile, fenster ganz, "EDIT/Druckausgabe", TRUE);
+  IF ja (zwischendatei drucken, "JA/Ausgabe drucken", FALSE) THEN
+    print (druckdatei)
+  END IF;
+  IF ja (zwischendatei loeschen, "JA/Ausgabe loeschen", FALSE) THEN
+    forget (druckdatei, quiet)
+  END IF .
+
+END PROC ergebnis anbieten;
+
+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' ***********************************)
+
+INITFLAG VAR diese task;
+
+TEXT VAR arbeitsbereich;
+
+LET
+  p task =  #1171#
+    ""15"Bereich "14"",
+  t neuer name =  #1172#
+    "Neuer Name:",
+  t zieldatei =  #1173#
+    "Zieldatei:",
+  t belegt =  #1174#
+    "belegt ",
+  t kb =  #1175#
+    "KB.",
+  t existiert nicht =  #1176#
+    " existiert nicht.",
+  t loeschen =  #1177#
+    " in dieser Task löschen";
+
+PROC dateiverwaltung (INT CONST wahl nr) :
+
+  enable stop;
+  SELECT wahl nr OF
+  CASE 0 : fusszeile aktualisieren
+  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 .
+
+fusszeile aktualisieren :
+  arbeitsbereich bestimmen;
+  fussteil (2, "", "") .
+
+datei reorganisieren :
+  ausfuehrung (PROC (TEXT CONST) aufraeumen) .
+
+datei umbenennen :
+  ausfuehrung (PROC (TEXT CONST) umbenennen) .
+
+datei loeschen :
+  ausfuehrung (PROC (TEXT CONST) loeschen) .
+
+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, fenster rechts, "SHOW/Uebersicht", FALSE)
+  END IF;
+  forget (list ds);
+  enable stop;
+  tastenpuffer loeschen .
+
+datei kopieren :
+  ausfuehrung (PROC (TEXT CONST) ds kopieren) .
+
+speicherbelegung datei :
+  ausfuehrung (PROC (TEXT CONST) speicherbelegung) .
+
+ggf dialogfenster loeschen :
+  IF wahl nr = -1 THEN
+    dialogfenster loeschen
+  END IF .
+
+END PROC dateiverwaltung;
+
+PROC arbeitsbereich bestimmen :
+
+  IF NOT initialized (diese task) THEN
+    neu bestimmen
+  END IF;
+  fussteil (1, p task, arbeitsbereich) .
+
+neu bestimmen :
+  IF station (myself) <> 0 THEN
+    arbeitsbereich := text (station (myself)) + "/"""
+  ELSE
+    arbeitsbereich := """"
+  END IF;
+  arbeitsbereich CAT name (myself);
+  arbeitsbereich CAT """" .
+
+END PROC arbeitsbereich bestimmen;
+
+PROC tastenpuffer loeschen :
+
+  WHILE getcharety <> niltext REP END REP
+
+END PROC tastenpuffer loeschen;
+
+PROC aufraeumen (TEXT CONST dateiname) :
+
+  bitte warten;
+  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", FALSE) .
+
+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 (textdarstellung (dateiname));
+  IF exists (dateiname) THEN
+    out (t belegt);
+    put (storage (old (dateiname)));
+    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;
+
+LET
+  p zielarchiv =  #1182#
+    ""15"Ziel "14"",
+  archiv heisst =  #1183#
+    "Archiv heisst ",
+  name des archivs =  #1184#
+    "Name des Archivs:",
+  name zielarchiv =  #1185#
+    "Name Zielarchiv:",
+  nr zielstation =  #1186#
+    "Nr. der Zielstation (od. RETURN):",
+  t zielmodus =  #1187#
+    "Art des Zielarchivs:",
+  diskette formatieren =  #1188#
+    "Diskette neu formatieren",
+  neuer archivname =  #1189#
+    "Neuer Archivname:",
+  t im system ueberschreiben =  #1190#
+    " in dieser Task überschreiben",
+  t auf archiv loeschen =  #1191#
+    " auf Archiv löschen",
+  t archiv =  #1192#
+    "Archiv ",
+  t ueberschreiben =  #1193#
+    " überschreiben",
+  diskette eingelegt =  #1194#
+    "Diskette eingelegt",
+  t auf archiv ueberschreiben =  #1195#
+    " auf Archiv überschreiben",
+  t formatparameter =  #1196#
+    "Mögliche Diskettenformate: ";
+
+LET
+  t passwort =  #1197#
+    "Passwort: ",
+  passwortwiederholung falsch =  #1198#
+    "Passwort stimmt nicht mit der ersten Eingabe überein",
+  bitte passwort wiederholen =  #1199#
+    "Passwort zur Kontrolle bitte nochmal eingeben:",
+  passwort loeschen =  #1200#
+    "Passwort löschen",
+  falsche stationsnr =  #1201#
+    "Unzulässige Stationsnummer",
+  task ist kein manager =  #1202#
+    "Angegebene Task ist kein Manager";
+
+ROW 4 TEXT VAR archivtask;
+    archivtask (1) := "ARCHIVE";
+    archivtask (2) := "PUBLIC";
+    archivtask (3) := "ARCHIVE360";
+    archivtask (4) := "DOS";
+
+
+PROC archivverwaltung (INT CONST menue nr, 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 :
+  arbeitsbereich bestimmen;
+  waehlbar (menue nr, 6, ziel ist manager);
+  waehlbar (menue nr, 9, NOT ziel ist manager);
+  fussteil (2, p zielarchiv, stationsnr + zielarchiv);
+  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) .
+
+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, archivinhalt) .
+
+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, archivinhalt) .
+
+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, fenster 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;
+  IF is error THEN forget (list name, quiet) 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 keine diskette COR benanntes archiv CAND loeschen verneint THEN
+    LEAVE archiv initialisieren
+  END IF;
+  BOOL CONST mit format := ja (diskette formatieren, "JA/format");
+  neuen namen erfragen;
+  tatsaechlich initialisieren .
+
+keine diskette :
+  NOT ja (diskette eingelegt, "JA/eingelegt") .
+
+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") .
+
+neuen namen erfragen :
+  editget (neuer archivname, letzter archivname, "", "GET/Archivname");
+  reserve (letzter archivname, eudas archiv) .
+
+tatsaechlich initialisieren :
+  IF mit format THEN
+    formatparameter abrufen;
+    archiv formatieren
+  ELSE
+    clear aufrufen
+  END IF .
+
+clear aufrufen :
+  bitte warten;
+  disable stop;
+  set command dialogue false;
+  clear (eudas archiv);
+  reset command dialogue .
+
+formatparameter abrufen :
+  INT VAR std := 1;
+  auswahl anbieten ("WAHL.Format", t formatparameter, "WAHL/format", std);
+  std DECR 1 .
+
+archiv formatieren :
+  bitte warten;
+  disable stop;
+  set command dialogue false;
+  format (std, eudas archiv);
+  reset command dialogue;
+  enable stop .
+
+zielarchiv einstellen :
+  INT VAR zielmodus := 1;
+  IF archivzugriff THEN
+    release (eudas archiv); archivzugriff := FALSE
+  END IF;
+  auswahl anbieten ("WAHL.Ziel", t zielmodus, "WAHL/zielarchiv", zielmodus);
+  TEXT VAR zieltaskname := archivtask (zielmodus);
+  IF zielmodus > 1 THEN
+    namen des zielarchivs erfragen
+  END IF;
+  zielstation einlesen;
+  werte uebertragen;
+  waehlbar (menue nr, 6, ziel ist manager);
+  waehlbar (menue nr, 9, NOT ziel ist manager);
+  bildschirm neu;
+  fussteil (2, stationsnr + zielarchiv) .
+
+namen des zielarchivs erfragen :
+  editget (name zielarchiv, zieltaskname, "", "GET/Zielarchiv");
+  IF zieltaskname = niltext THEN
+    LEAVE zielarchiv einstellen
+  END IF;
+  archivtask (zielmodus) := zieltaskname .
+
+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;
+  ziel ist manager := zielmodus = 1 OR zielmodus = 3;
+  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
+  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", FALSE) .
+
+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", FALSE) .
+
+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", FALSE) .
+
+END PROC auf archiv loeschen;
+
+PROC passwort einstellen :
+
+  BOUND ROW 2 TEXT VAR pw;
+  DATASPACE VAR ds := nilspace;
+  pw := ds;
+  disable stop;
+  passwort holen (t passwort, 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
+    set command dialogue false;
+    enter password (niltext);
+    reset command dialogue
+  END IF .
+
+doppelt eingeben :
+  passwort holen (bitte passwort wiederholen, pw (2));
+  IF pw (1) <> pw (2) THEN
+    errorstop (passwortwiederholung falsch)
+  ELSE
+    set command dialogue false;
+    enter password (pw (1));
+    reset command dialogue
+  END IF .
+
+END PROC passwort einstellen;
+
+PROC passwort holen (TEXT CONST prompt, TEXT VAR wort) :
+
+  enable stop;
+  dialog (prompt);
+  get secret line (wort)
+
+END PROC passwort holen;
+
+
+(********************** Auswahlinterface **********************************)
+
+SATZ VAR
+  sammel;
+
+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 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", fenster 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 type (blank) END IF;
+    feldnamen lesen (wahl (stelle), feldpuffer);
+    type ("<"); type (feldpuffer); type (">");
+    stelle INCR 1
+  END REP .
+
+END PROC feldnamen anzeigen;
+
+PROC einzelausfuehrung (TEXT CONST prompt, INT CONST typ,
+                        PROC (TEXT CONST) operation) :
+
+  ausfuehrung (prompt, TRUE, typ, PROC (TEXT CONST) operation)
+
+END PROC einzelausfuehrung;
+
+PROC ausfuehrung (TEXT CONST prompt, INT CONST typ,
+                  PROC (TEXT CONST) operation) :
+
+  ausfuehrung (prompt, FALSE, typ, PROC (TEXT CONST) operation)
+
+END PROC ausfuehrung;
+
+PROC ausfuehrung (PROC (TEXT CONST) operation) :
+
+  ausfuehrung (name der datei, 0, PROC (TEXT CONST) operation)
+
+END PROC ausfuehrung;
+
+END PACKET eudas steuerung;
+
-- 
cgit v1.2.3