summaryrefslogtreecommitdiff
path: root/app/eudas/5.3/src/eudas.steuerung.14
diff options
context:
space:
mode:
Diffstat (limited to 'app/eudas/5.3/src/eudas.steuerung.14')
-rw-r--r--app/eudas/5.3/src/eudas.steuerung.142535
1 files changed, 2535 insertions, 0 deletions
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;
+