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;