summaryrefslogtreecommitdiff
path: root/system/base/1.7.5/src/functions
diff options
context:
space:
mode:
authorLars-Dominik Braun <lars@6xq.net>2019-02-04 13:09:03 +0100
committerLars-Dominik Braun <lars@6xq.net>2019-02-04 13:09:03 +0100
commit04e68443040c7abad84d66477e98f93bed701760 (patch)
tree2b6202afae659e773bf6916157d23e83edfa44e3 /system/base/1.7.5/src/functions
downloadeumel-src-04e68443040c7abad84d66477e98f93bed701760.tar.gz
eumel-src-04e68443040c7abad84d66477e98f93bed701760.tar.bz2
eumel-src-04e68443040c7abad84d66477e98f93bed701760.zip
Initial import
Diffstat (limited to 'system/base/1.7.5/src/functions')
-rw-r--r--system/base/1.7.5/src/functions760
1 files changed, 760 insertions, 0 deletions
diff --git a/system/base/1.7.5/src/functions b/system/base/1.7.5/src/functions
new file mode 100644
index 0000000..9f338ff
--- /dev/null
+++ b/system/base/1.7.5/src/functions
@@ -0,0 +1,760 @@
+PACKET editor functions DEFINES (* FUNCTIONS - 052 *)
+ (**************) (* 17.07.85 -bk- *)
+ (* 10.09.85 -ws- *)
+ edit, (* 25.04.86 -sh- *)
+ show, (* 27.05.86 -wk- *)
+ U,
+ D,
+ T,
+ up,
+ down,
+ downety,
+ uppety,
+ to line,
+ PUT,
+ GET,
+ P,
+ G,
+ limit,
+ len,
+ eof,
+ C,
+ change to,
+ CA,
+ change all,
+ lines,
+ line no,
+ col,
+ mark,
+ at,
+ word,
+ std kommando interpreter,
+ note,
+ note line,
+ note edit,
+ anything noted,
+ note file:
+
+
+LET marker = "^",
+ ersatzmarker = "'",
+ schritt = 50,
+ file size = 4072,
+ write acc = TRUE,
+ read acc = FALSE;
+
+LET bold = 2,
+ integer = 3,
+ string = 4,
+ end of file = 7;
+
+LET std res = "eqvw19dpgn"9"";
+
+FILE VAR edfile;
+BOOL VAR from scratchfile :: FALSE;
+TEXT VAR kommandotext, tabulator, zeile;
+
+
+PROC std kommando interpreter (TEXT CONST taste) :
+ enable stop ;
+ edfile := editfile;
+ set busy indicator;
+ SELECT pos (std res, taste) OF
+ CASE 1 (*e*) : edit
+ CASE 2 (*q*) : quit
+ CASE 3 (*v*) : quit last
+ CASE 4 (*w*) : open editor (next editor)
+ CASE 5 (*1*) : toline (1); col (1)
+ CASE 6 (*9*) : toline (lines); col (len+1)
+ CASE 7 (*d*) : d case
+ CASE 8 (*p*) : p case
+ CASE 9 (*g*) : g case
+ CASE 10(*n*) : note edit
+ CASE 11(*tab*): change tabs
+ OTHERWISE : echtes kommando analysieren
+ END SELECT .
+
+d case :
+ IF mark
+ THEN PUT ""; mark (FALSE); from scratchfile := TRUE
+ ELSE textzeile auf taste legen
+ FI .
+
+p case :
+ IF mark (*sh*)
+ THEN IF write permission
+ THEN PUT ""; push(""27""12""); from scratchfile := TRUE
+ ELSE out (""7"")
+ FI
+ ELSE textzeile auf taste legen
+ FI .
+
+g case :
+ IF write permission (*sh*)
+ THEN IF from scratchfile
+ THEN GET ""
+ ELSE IF is editget
+ THEN push (lernsequenz auf taste ("g")); nichts neu
+ FI
+ FI
+ ELSE out (""7"")
+ FI .
+
+textzeile auf taste legen :
+ read record (edfile, zeile);
+ zeile := subtext (zeile, col);
+ lernsequenz auf taste legen ("g", zeile);
+ from scratchfile := FALSE; zeile neu .
+
+next editor :
+ (aktueller editor MOD groesster editor) + 1 .
+
+change tabs :
+ get tabs (edfile, tabulator) ;
+ IF pos (tabulator, marker) <> 0
+ THEN change all (tabulator, marker, ersatzmarker)
+ ELSE change all (tabulator, ersatzmarker, marker)
+ FI ;
+ put tabs (edfile, tabulator) ;
+ ueberschrift neu .
+
+echtes kommando analysieren :
+ kommandotext := kommando auf taste (taste);
+ IF kommandotext = ""
+ THEN nichts neu; LEAVE std kommando interpreter
+ FI ;
+ scan (kommandotext);
+ TEXT VAR s1; INT VAR t1; next symbol (s1, t1);
+ TEXT VAR s2; INT VAR t2; next symbol (s2, t2);
+ IF t1 = integer AND t2 = end of file THEN toline (int (s1))
+ ELIF t1 = string AND t2 = end of file THEN down (s1)
+ ELIF perhaps simple up or down THEN
+ ELIF perhaps simple changeto THEN
+ ELSE do (kommandotext)
+ FI .
+
+perhaps simple up or down :
+ IF t1 = bold
+ THEN TEXT VAR s3; INT VAR t3; next symbol (s3, t3);
+ IF t3 <> end of file THEN FALSE
+ ELIF s1 = "U" THEN perhaps simple up
+ ELIF s1 = "D" THEN perhaps simple down
+ ELSE FALSE
+ FI
+ ELSE FALSE
+ FI .
+
+perhaps simple up :
+ IF t2 = string THEN up (s2); TRUE
+ ELIF t2 = integer THEN up (int (s2)); TRUE
+ ELSE FALSE
+ FI .
+
+perhaps simple down :
+ IF t2 = string THEN down (s2); TRUE
+ ELIF t2 = integer THEN down (int (s2)); TRUE
+ ELSE FALSE
+ FI .
+
+perhaps simple changeto :
+ IF t1 = string AND s2 = "C" AND t3 is string AND t4 is eof
+ THEN s1 C s3; TRUE
+ ELSE FALSE
+ FI .
+
+t3 is string :
+ next symbol (s3, t3);
+ t3 = string .
+
+t4 is eof :
+ TEXT VAR s4; INT VAR t4;
+ next symbol (s4, t4);
+ t4 = end of file .
+END PROC std kommando interpreter;
+
+
+PROC edit (FILE VAR f) :
+ enable stop;
+ IF aktueller editor > 0 (*wk*)
+ THEN ueberschrift neu
+ FI ;
+ open editor (f, write acc);
+ edit (groesster editor, std res, PROC(TEXT CONST) std kommando interpreter)
+END PROC edit;
+
+
+PROC edit (FILE VAR f, INT CONST x, y, x size, y size) :
+ enable stop;
+ open editor (groesster editor + 1, f, write acc, x, y, x size, y size);
+ edit (groesster editor, std res, PROC(TEXT CONST) std kommando interpreter)
+END PROC edit;
+
+
+PROC edit (FILE VAR f, TEXT CONST res, PROC (TEXT CONST) kdo interpreter) :
+ enable stop;
+ open editor (f, write acc);
+ edit (groesster editor, res, PROC(TEXT CONST) kdo interpreter)
+END PROC edit;
+
+
+PROC edit :
+ IF aktueller editor > 0
+ THEN dateiname einlesen;
+ edit (dateiname)
+ ELSE edit (last param)
+ FI .
+
+dateiname einlesen :
+ INT VAR x, y; get editcursor (x, y);
+ IF x < x size - 17 (*sh*)
+ THEN cursor (x, y);
+ out (""15"Dateiname:"14"");
+ (x size-14-x) TIMESOUT " ";
+ (x size-14-x) TIMESOUT ""8"";
+ TEXT VAR dateiname := std;
+ editget (dateiname);
+ trailing blanks entfernen;
+ quotes entfernen
+ ELSE errorstop ("Fenster zu klein")
+ FI .
+
+trailing blanks entfernen:
+ INT VAR i := LENGTH dateiname;
+ WHILE (dateiname SUB i) = " " REP i DECR 1 PER;
+ dateiname := subtext (dateiname, 1, i) .
+
+quotes entfernen :
+ IF (dateiname SUB 1) = """" AND (dateiname SUB LENGTH dateiname) = """"
+ THEN dateiname := subtext (dateiname, 2, LENGTH dateiname - 1)
+ FI .
+END PROC edit;
+
+
+PROC edit (TEXT CONST filename) :
+ IF filename <> ""
+ THEN edit named file
+ ELSE errorstop ("Name ungueltig")
+ FI .
+
+edit named file :
+ last param (filename);
+ IF exists (filename) COR yes ("""" + filename + """ neu einrichten")
+ THEN IF aktueller editor > 0 THEN ueberschrift neu FI; (*sh*)
+ FILE VAR f := sequential file (modify, filename);
+ headline (f, filename); edit (f); last param (filename)
+ ELSE errorstop ("")
+ FI .
+END PROC edit;
+
+
+PROC edit (TEXT CONST filename, INT CONST x, y, x size, y size) :
+ last param (filename);
+ IF exists (filename) COR yes ("""" + filename + """ neu einrichten")
+ THEN FILE VAR f := sequential file (modify, filename);
+ headline (f, filename); edit (f, x, y, x size, y size);
+ last param (filename)
+ ELSE errorstop ("")
+ FI
+END PROC edit;
+
+
+PROC edit (INT CONST i) :
+ edit (i, std res, PROC (TEXT CONST) std kommando interpreter)
+END PROC edit;
+
+
+PROC show (FILE VAR f) :
+ enable stop;
+ open editor (f, read acc);
+ edit(groesster editor, std res, PROC(TEXT CONST) std kommando interpreter);
+END PROC show;
+
+
+PROC show (TEXT CONST filename) : (*sh*)
+ last param (filename);
+ IF exists (filename)
+ THEN FILE VAR f := sequential file (modify, filename);
+ show (f); last param (filename)
+ ELSE errorstop ("""" + filename + """ gibt es nicht")
+ FI
+END PROC show;
+
+
+PROC show :
+ show (last param)
+END PROC show;
+
+
+DATASPACE VAR local space;
+INT VAR zeilenoffset;
+TEXT VAR kopierzeile;
+
+
+OP PUT (TEXT CONST filename) :
+ nichts neu;
+ IF mark
+ THEN markierten bereich in datei schreiben
+ FI .
+
+markierten bereich in datei schreiben :
+ disable stop;
+ zieldatei vorbereiten;
+ quelldatei oeffnen;
+ IF noch genuegend platz in der zieldatei (*sh*)
+ THEN zeilenweise kopieren
+ ELSE errorstop ("FILE-Ueberlauf")
+ FI ;
+ quelldatei schliessen;
+ zieldatei schliessen;
+ set busy indicator .
+
+zieldatei vorbereiten :
+ FRANGE VAR ganze zieldatei;
+ IF exists (filename) THEN forget (filename); ueberschrift neu FI;
+ FILE VAR destination;
+ IF filename = ""
+ THEN forget (local space); local space := nilspace;
+ destination := sequential file (output, local space)
+ ELSE destination := sequential file (modify, filename) ;
+ INT CONST groesse der zieldatei := lines (destination); (*sh*)
+ set marked range (destination, ganze zieldatei) ;
+ output (destination)
+ FI .
+
+quelldatei oeffnen :
+ zeilenoffset := mark line no (edfile) - 1;
+ INT CONST old line := line no, old col := col;
+ FRANGE VAR ganze datei;
+ set range (edfile, mark lineno (edfile), mark col (edfile), ganze datei);
+ input (edfile) .
+
+noch genuegend platz in der zieldatei :
+ lines + groesse der zieldatei < file size .
+
+zeilenweise kopieren :
+ enable stop;
+ satznr neu;
+ INT VAR zeile;
+ FOR zeile FROM 1 UPTO lines (edfile) REP
+ getline (edfile, kopierzeile);
+ putline (destination, kopierzeile);
+ satznr zeigen
+ PER .
+
+quelldatei schliessen :
+ modify (edfile);
+ set range (edfile, ganze datei);
+ to line (old line);
+ col (old col) .
+
+zieldatei schliessen :
+ IF filename <> ""
+ THEN INT CONST last line written := line no (destination) ;
+ modify (destination) ;
+ to line (destination, last line written) ;
+ col (destination, len (destination) + 1) ;
+ bild neu (destination) ;
+ set range (destination, ganze zieldatei)
+ FI .
+END OP PUT;
+
+
+OP P (TEXT CONST filename) :
+ PUT filename
+END OP P ;
+
+
+OP GET (TEXT CONST filename) : (*sh*)
+ IF NOT write permission
+ THEN errorstop ("Schreibversuch auf 'show'-Datei")
+ FI ;
+ quelldatei oeffnen;
+ IF nicht mehr genuegend platz im editfile
+ THEN quelldatei schliessen; errorstop ("FILE-Ueberlauf")
+ FI ;
+ disable stop;
+ zieldatei oeffnen;
+ zeilenweise kopieren ;
+ zieldatei schliessen;
+ quelldatei schliessen;
+ set busy indicator .
+
+quelldatei oeffnen :
+ FILE VAR source;
+ FRANGE VAR ganze quelldatei;
+ IF filename = ""
+ THEN source := sequential file (input, local space)
+ ELSE IF NOT exists (filename)
+ THEN errorstop ("""" + filename + """ gibt es nicht")
+ FI ;
+ source := sequential file (modify, filename);
+ INT CONST old line := line no (source),
+ old col := col (source);
+ set marked range (source, ganze quelldatei);
+ input (source)
+ FI .
+
+nicht mehr genuegend platz im editfile :
+ lines (source) + lines >= file size .
+
+zeilenweise kopieren :
+ enable stop;
+ satznr neu;
+ INT VAR zeile;
+ FOR zeile FROM 1 UPTO lines (source) REP
+ getline (source, kopierzeile);
+ putline (edfile, kopierzeile);
+ satznr zeigen
+ PER .
+
+zieldatei oeffnen :
+ zeilenoffset := line no - 1;
+ leere datei in editfile einschachteln;
+ output (edfile) .
+
+leere datei in editfile einschachteln :
+ INT CONST range start col := col;
+ FRANGE VAR ganze datei;
+ set range (edfile, line no, col, ganze datei);
+ IF lines = 1 THEN delete record (edfile) FI .
+
+quelldatei schliessen :
+ IF filename <> ""
+ THEN modify (source);
+ set range (source, ganze quelldatei);
+ to line (source, old line);
+ col (source, old col)
+ FI .
+
+zieldatei schliessen :
+ modify (edfile);
+ to line (lines);
+ col (range start col);
+ set range (edfile, ganze datei);
+ abschnitt neu (zeilenoffset + 1, lines) .
+END OP GET;
+
+
+OP G (TEXT CONST filename) :
+ GET filename
+END OP G;
+
+
+INT PROC len :
+ len (edfile)
+END PROC len;
+
+
+PROC col (INT CONST stelle) :
+ nichts neu; col (edfile, stelle)
+END PROC col;
+
+
+INT PROC col :
+ col (edfile)
+END PROC col;
+
+
+PROC limit (INT CONST limit) :
+ nichts neu; max line length (edfile, limit)
+END PROC limit;
+
+
+INT PROC limit :
+ max line length (edfile)
+END PROC limit;
+
+
+INT PROC lines :
+ lines (edfile)
+END PROC lines;
+
+
+INT PROC line no :
+ line no (edfile)
+END PROC line no;
+
+
+PROC to line (INT CONST satz nr) :
+ satznr neu;
+ edfile := editfile;
+ IF satz nr > lines
+ THEN toline (edfile, lines); col (len + 1)
+ ELSE to line (edfile, satz nr)
+ FI
+END PROC to line;
+
+
+OP T (INT CONST satz nr) :
+ to line (satz nr)
+END OP T;
+
+
+PROC down (INT CONST anz) :
+ nichts neu; down (edfile, anz)
+END PROC down;
+
+
+OP D (INT CONST anz) :
+ down (anz)
+END OP D;
+
+
+PROC up (INT CONST anz) :
+ nichts neu; up (edfile, anz)
+END PROC up;
+
+
+OP U (INT CONST anz) :
+ up (anz)
+END OP U;
+
+
+PROC down (TEXT CONST muster) :
+ nichts neu;
+ REP
+ down (muster, schritt - line no MOD schritt);
+ IF pattern found
+ THEN LEAVE down
+ ELSE satznr zeigen
+ FI
+ UNTIL eof PER
+END PROC down;
+
+
+OP D (TEXT CONST muster) :
+ down (muster)
+END OP D;
+
+
+PROC down (TEXT CONST muster, INT CONST anz) :
+ nichts neu; down (edfile, muster, anz)
+END PROC down;
+
+
+PROC up (TEXT CONST muster) :
+ nichts neu;
+ REP
+ up (muster, (line no - 1) MOD schritt + 1);
+ IF pattern found
+ THEN LEAVE up
+ ELSE satznr zeigen
+ FI
+ UNTIL line no = 1 PER
+END PROC up;
+
+
+OP U (TEXT CONST muster) :
+ up (muster)
+END OP U;
+
+
+PROC up (TEXT CONST muster, INT CONST anz) :
+ nichts neu; up (edfile, muster, anz)
+END PROC up;
+
+
+PROC downety (TEXT CONST muster) :
+ nichts neu;
+ IF NOT at (muster)
+ THEN down (muster)
+ FI
+END PROC downety;
+
+
+PROC downety (TEXT CONST muster, INT CONST anz) :
+ nichts neu; downety (edfile, muster, anz)
+END PROC downety;
+
+
+PROC uppety (TEXT CONST muster) :
+ nichts neu;
+ IF NOT at (muster)
+ THEN up (muster)
+ FI
+END PROC uppety;
+
+
+PROC uppety (TEXT CONST muster, INT CONST anz) :
+ nichts neu; uppety (edfile, muster, anz)
+END PROC uppety;
+
+
+OP C (TEXT CONST old, new) :
+ change to (old, new)
+END OP C;
+
+OP C (TEXT CONST replacement) :
+ IF NOT write permission (*sh*)
+ THEN errorstop ("Schreibversuch auf 'show'-Datei")
+ FI ;
+ IF at (edfile, match(0))
+ THEN zeile neu; change (edfile, matchpos(0), matchend(0), replacement)
+ FI
+END OP C;
+
+PROC change to (TEXT CONST old, new) :
+ IF NOT write permission (*sh*)
+ THEN errorstop ("Schreibversuch auf 'show'-Datei")
+ FI ;
+ nichts neu;
+ REP
+ downety (old, schritt - line no MOD schritt);
+ IF pattern found
+ THEN change (edfile, matchpos(0), matchend(0), new);
+ col (col + LENGTH new); zeile neu;
+ LEAVE changeto
+ ELSE satznr zeigen
+ FI
+ UNTIL eof PER
+END PROC change to;
+
+
+OP CA (TEXT CONST old, new) :
+ change all (old, new)
+END OP CA;
+
+
+PROC change all (TEXT CONST old, new) :
+ WHILE NOT eof REP old C new PER
+END PROC change all;
+
+
+BOOL PROC eof :
+ eof (edfile)
+END PROC eof;
+
+
+BOOL PROC mark :
+ mark (edfile)
+END PROC mark;
+
+
+PROC mark (BOOL CONST mark on) :
+ nichts neu;
+ IF mark on
+ THEN mark (edfile, line no, col)
+ ELSE mark (edfile, 0, 0)
+ FI
+END PROC mark;
+
+
+BOOL PROC at (TEXT CONST pattern) :
+ at (edfile, pattern)
+END PROC at;
+
+TEXT PROC word :
+ word (edfile)
+END PROC word;
+
+
+TEXT PROC word (TEXT CONST sep) :
+ word (edfile, sep)
+END PROC word;
+
+
+TEXT PROC word (INT CONST len) :
+ word (edfile, len)
+END PROC word;
+
+
+LET no access = 0,
+ edit access = 1,
+ output access = 2;
+
+INT VAR last note file mode;
+FILE VAR notebook;
+INITFLAG VAR this packet := FALSE;
+DATASPACE VAR note ds;
+
+
+PROC note (TEXT CONST text) :
+ access note file (output access);
+ write (notebook, text)
+END PROC note;
+
+
+PROC note (INT CONST number) :
+ access note file (output access);
+ put (notebook, number)
+END PROC note;
+
+
+PROC note line :
+ access note file (output access);
+ line (notebook)
+END PROC note line;
+
+
+BOOL PROC anything noted :
+ access note file (no access);
+ last note file mode = output access
+END PROC anything noted;
+
+
+FILE PROC note file :
+ access note file (output access);
+ notebook
+END PROC note file;
+
+
+PROC note edit (FILE VAR context) : (*sh*)
+ access note file (edit access);
+ make notebook erasable;
+ IF aktueller editor = 0
+ THEN open editor (1, context, write acc, 1, 1, x size - 1, y size)
+ FI ;
+ get window size;
+ IF window large enough
+ THEN include note editor;
+ edit (aktueller editor-1, aktueller editor, aktueller editor-1,
+ std res, PROC (TEXT CONST) std kommando interpreter)
+ FI .
+
+get window size :
+ INT VAR x, y, windows x size, windows y size;
+ get window (x, y, windows x size, windows y size) .
+
+window large enough :
+ windows y size > 4 .
+
+include note editor :
+ open editor (aktueller editor + 1, notebook, write acc,
+ x, y + (windows y size + 1) DIV 2,
+ windows x size, windows y size DIV 2) .
+
+make notebook erasable :
+ last note file mode := edit access .
+END PROC note edit;
+
+
+PROC note edit :
+ access note file (edit access);
+ make notebook erasable;
+ edit (notebook) .
+
+make notebook erasable :
+ last note file mode := edit access .
+END PROC note edit;
+
+
+PROC access note file (INT CONST new mode) :
+ disable stop;
+ initialize note ds if necessary;
+ IF last note file mode < new mode
+ THEN forget (note ds);
+ note ds := nilspace;
+ notebook := sequential file (output, note ds);
+ headline (notebook, "notebook");
+ last note file mode := new mode
+ FI .
+
+initialize note ds if necessary :
+ IF NOT initialized (this packet)
+ THEN note ds := nilspace;
+ last note file mode := no access
+ FI .
+END PROC access note file;
+
+END PACKET editor functions;
+