diff options
Diffstat (limited to 'system/multiuser/1.7.5/src/macro store')
| -rw-r--r-- | system/multiuser/1.7.5/src/macro store | 298 |
1 files changed, 298 insertions, 0 deletions
diff --git a/system/multiuser/1.7.5/src/macro store b/system/multiuser/1.7.5/src/macro store new file mode 100644 index 0000000..dc13a1b --- /dev/null +++ b/system/multiuser/1.7.5/src/macro store @@ -0,0 +1,298 @@ +(* ------------------- VERSION 13 vom 28.05.86 -------------------- *) +PACKET macro store DEFINES macro command and then process parameters, + get macro line, + number macro lines, + load macros, + list macros: + +(* Programm zur Behandlung von Textkosemtik-Macros + Autor: Rainer Hahn + Stand: 1.7.1 (Febr. 1984) +*) + +INITFLAG VAR this packet :: FALSE; + +DATASPACE VAR ds; + +BOUND MACROTABLE VAR macro table; + +FILE VAR f; + +LET MACROTABLE = STRUCT (ROW max macros TEXT replacement store, + ROW max macro zeilen TEXT macro zeilen, + ROW max macros TEXT macro namen, + ROW max macros INT anz parameter, + ROW max macros INT macro start); + + +LET tag = 1, + number = 3, + delimiter = 6, + end of scan = 7, + max macro zeilen = 1000, + max macros = 200; + +INT VAR index aktuelle macro zeile, + type, + anz zeilen in macro, + anz macro zeilen, + anz macros :: 0; + +TEXT VAR symbol, + fehlertext, + dummy, + kommando, + zeile; + +BOOL VAR with parameters, + macro end gewesen; + +PROC init macros: + IF NOT initialized (this packet) + THEN ds := nilspace; + macro table := ds; + macros leeren + FI. + +macros leeren: + anz macro zeilen := 0; + anz macros := 0. +END PROC init macros; + +PROC load macros (TEXT CONST fname): + init macros; + line; + IF exists (fname) + THEN f := sequential file (input, fname); + forget (ds); + ds := nilspace; + macro table := ds; + macros einlesen + ELSE errorstop ("Datei existiert nicht") + FI. + +macros einlesen: + macro end gewesen := TRUE; + anz macros := 0; + anz macro zeilen := 0; + WHILE NOT eof (f) REP + anz macro zeilen INCR 1; + IF anz macro zeilen > max macro zeilen + THEN errorstop ("Zu viele Zeilen (max.1000)") + FI; + cout (anz macro zeilen); + getline (f, zeile); + IF zeile = "" + THEN zeile := " " + ELIF pos (zeile, "#*") > 0 + THEN macro name oder end vermerken + FI; + IF macro end gewesen AND zeile = " " + THEN anz macro zeilen DECR 1 + ELSE macro table . macro zeilen [anz macro zeilen] := zeile + FI + END REP; + anz macro zeilen INCR 1; + macro table . macro zeilen [anz macro zeilen] := " "; + IF anz macros = 0 + THEN putline ("Macros geleert") + FI. + +macro name oder end vermerken: + INT CONST komm anfang :: pos (zeile, "#*") + 2, + komm ende :: pos (zeile, "#", komm anfang); + IF komm anfang <> 3 OR hinter dem kommando steht noch was + THEN errorstop ("Macro-Anweisung steht nicht alleine auf der Zeile"); + FI; + kommando := subtext (zeile, komm anfang, komm ende -1); + scan (kommando); + next symbol (symbol, type); + IF type = tag + THEN macro namen aufnehmen + ELSE errorstop ("kein Macroname nach #*") + FI; + next symbol (symbol, type); + IF type >= end of scan + THEN macro table . anz parameter [anz macros] := 0; + LEAVE macro name oder end vermerken + ELIF symbol = "(" + THEN parameter aufsammeln; + ELSE errorstop ("keine ( nach Macro-Name") + FI. + +macro namen aufnehmen: + IF symbol = "macroend" + THEN put ("mit"); put (macro table . anz parameter [anz macros]); + put ("Parameter(n) geladen"); + macro end gewesen := TRUE; + line; + LEAVE macro name oder end vermerken + ELIF NOT macro end gewesen + THEN errorstop ("macro end fehlt") + ELSE macro end gewesen := FALSE; + anz macros INCR 1; + IF anz macros > max macros + THEN errorstop ("Zu viele Macros (max. 200") + FI; + macro table . macro namen [anz macros] := symbol; + macro table . macro start [anz macros] := anz macro zeilen; + line; + put (symbol); + FI. + +hinter dem kommando steht noch was: + NOT (komm ende = length (zeile) COR + (komm ende + 1 = length (zeile) AND (zeile SUB komm ende + 1) = " ")). + +parameter aufsammeln: + INT VAR parameter number :: 1; + next symbol (symbol, type); + WHILE symbol = "$" REP + next symbol (symbol, type); + IF type = number CAND int (symbol) = parameter number + THEN IF parameter number > 9 + THEN errorstop ("Anzahl Parameter > 9") + FI; + macro table . anz parameter [anz macros] := parameter number; + parameter number INCR 1; + ELSE errorstop ("Parameter-Nummer inkorrekt: " + symbol) + FI; + next symbol (symbol, type); + IF symbol = ")" + THEN LEAVE parameter aufsammeln + ELIF symbol = "," + THEN next symbol (symbol, type) + ELSE errorstop (", oder ) erwartet:" + symbol) + FI + END REP; + errorstop ("Parameterliste inkorrekt bei" + symbol). +END PROC load macros; + +PROC load macros: + load macros (last param) +END PROC load macros; + +PROC list macros: + init macros; + note (""); + INT VAR i := 1; + WHILE i <= anz macro zeilen REP + cout (i); + note (macro table . macro zeilen [i]); + note line; + i INCR 1 + END REP; + note edit +END PROC list macros; + +BOOL PROC macro exists (TEXT CONST name, INT VAR anz params): + INT VAR i; + FOR i FROM 1 UPTO anz macros REP + IF macro table . macro namen [i] = name + THEN anz params := macro table . anz parameter [i]; + index aktuelle macro zeile := macro table . macro start [i] + 1; + berechne anzahl zeilen in macro; + IF anz params = 0 + THEN with parameters := FALSE + ELSE with parameters := TRUE; + lade macro in replacement store; + index aktuelle macro zeile := 1; + FI; + LEAVE macro exists WITH TRUE + FI + END REP; + FALSE. + +berechne anzahl zeilen in macro: + IF i = anz macros + THEN anz zeilen in macro := + anz macro zeilen - index aktuelle macro zeile; + ELSE anz zeilen in macro := + macro table . macro start [i + 1] - index aktuelle macro zeile + FI. + +lade macro in replacement store: + INT VAR k; + FOR k FROM 1 UPTO anz zeilen in macro REP + macro table . replacement store [k] := + macro table . macro zeilen [index aktuelle macro zeile +k-1] + END REP. +END PROC macro exists; + +PROC replace macro parameter (INT CONST number, TEXT CONST param): + TEXT VAR param text := "$" + text (number); + INT VAR k; + FOR k FROM 1 UPTO anz zeilen in macro - 1 REP + change all (macro table . replacement store [k], param text, param); + END REP +END PROC replace macro parameter; + +BOOL PROC macro command and then process parameters (TEXT VAR komm): + init macros; + LET tag = 1; + scan (komm); + next symbol (symbol, type); + IF type = tag + THEN untersuche ob deklariertes macro + ELSE FALSE + FI. + +untersuche ob deklariertes macro: + INT VAR anz macro params; + IF macro exists (symbol, anz macro params) + THEN fehlertext := "in Makro: "; fehlertext CAT symbol; + IF anz macro params > 0 + THEN macro parameter ersetzen + FI; + TRUE + ELSE FALSE + FI. + +macro parameter ersetzen: + next symbol (symbol, type); + IF symbol = "(" + THEN ersetze + ELSE report text processing error (34, 0, dummy, symbol + fehlertext); + LEAVE macro command and then process parameters WITH FALSE + FI. + +ersetze: + LET text type = 4, + end of scan = 7; + INT VAR number parameter :: 1; + REP + next symbol (symbol, type); + IF type = texttype + THEN replace macro parameter (number parameter, symbol); + ELSE report text processing error (35, 0, dummy, fehlertext + symbol); + LEAVE macro command and then process parameters WITH FALSE + FI; + number parameter INCR 1; + IF number parameter > anz macro params + THEN LEAVE macro command and then process parameters WITH TRUE + FI; + next symbol (symbol, type); + IF symbol <> "," OR type >= end of scan + THEN report text processing error (36, 0, dummy, fehlertext + symbol); + LEAVE macro command and then process parameters WITH FALSE + FI + END REP. +END PROC macro command and then process parameters; + +PROC get macro line (TEXT VAR macro zeile): + IF index aktuelle macro zeile > anz zeilen in macro + THEN macro zeile := "#### " + ELIF with parameters + THEN macro zeile := + macro table . replacement store [index aktuelle macro zeile] + ELSE macro zeile := + macro table . macro zeilen [index aktuelle macro zeile] + FI; + index aktuelle macro zeile INCR 1; +END PROC get macro line; + +INT PROC number macro lines: + anz zeilen in macro +END PROC number macro lines; +END PACKET macro store; + |